/ 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 / WPUTIL - UTILITY BUILD PROGRAM / ******** EDIT HISTORY ******* / / 002 WCE 21-AUG-84 MAKE DICTIONARY DISKS INTO ACTIVATE DISKS / 001 WJY 04-JUN-84 SUPPORT UPDATING AMERICAN & BRITISH / DICTIONARIES. / THIS PROGRAM WAS CRATED ON 25 OCT 83 BY WILLIAM EKLE TO PROVIDE A MEANS / OF GENERATING A UTILITY COMBINATION DISKETTE FOR FUNCTIONS THAT HAVE BEEN / OFF-LOADED FROM THE WPS SYSTEM DISKETTE. / / IN ACTUAL USE, THE DEVELOPERS WILL USE THIS PROGRAM TO TRANSFER THIER / CODE FROM AN EIGHT INCH FLOPPY DISKETTE TO A FIVE INCH DISKETTE. / / THE DISKETTE THAT CONTAINS THIS PROGRAM IS A MODIFIED SYSTEM DISKETTE / THAT HAS ONLY THE MINIMUM FILES NECESSARY TO BOOT THE STANDARD SYSTEM. / / WHEN THE STANDARD SYSTEM IS BOOTED UP, IT TRANSFERS CONTROL TO THE / MODULE WPCU2. THIS PROGRAM OCCUPIES THE SLOT THAT WAS USED BY WPCU2 / TO DISLPAY THE RESET DATE AND TIME MENU. / / TO BUILD A BASIC DISKETTE, LOAD THE FOLLOWING FILES ON A BLANK DISKETTE: / / LOADB7, WPFILS, DSKHND, WPSYSA, WPUTIL / / THEN LOAD THE VARIOUS MODULES FOR SPELL, GRAPHICS, POST PROCESSING, ETC. / / CURRENTLY, THE UTILITY DISKETTE SUPPORTS FOUR KINDS OF OPERATIONS WHICH ARE: / / BUILD UTILITY COMBINATION DISKETTE / BUILD ACTIVATE FEATURE DISKETTES / UPDATE SPELLING DICTIONARY DISKETTES / BOOT AN RX-50 SYSTEM DISKETTE ON A DECMATE II / / THE KEY TO UNDERSTANDING PROGRAM OPERATION IS IN KNOWING WHAT VALUES ARE / PASSED IN THE MENU TEMP'S FROM THE USER SELECTION MENUS. / / MNTMP3 CONTAINS THE FUNCTION CODE FOR THE OPERATION / / 0 = UPDATE DICTIONARY DISKETTE / 1 = BUILD UTILITY COMBINATION DISKETTE / 2 = BUILD ACTIVATE FEATURE DISKETTE / 3 = BOOT RX-50 SYSTEM DISKETTE ON A DECMATE II / / MNTMP4 CONTAINS THE INITIALIZATION DISK DRIVE NUMBER / / MNTMP5 CONTAINS A BIT SET FOR THE ACTIVATE FEATURE DISK TO BE BUILT / / COMBIT = 1 FOR COMMUNICATIONS / LPBIT = 2 FOR LIST PROCESSING / SRBIT = 4 FOR SORT / MABIT = 10 FOR MATH / SEDBIT = 20 FOR SPELLING /*************************************************************************** /**** WRITE OUT CODE FOR WPUTIL **** /*************************************************************************** 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 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 DLUTL1; 0; CDF 20; -1 / WRITE OUT FIRST PART OF UTILITY DLUTL2; 400; CDF 20; -DSUTL2 / WRITE OUT SECOND PART OF UTILITY DLMUT1; ADMUT1; CDF 20; -DSMENU / WRITE OUT FIRST UTILITY MENU BLOCK DLMUT2; ADMUT2; CDF 20; -DSMENU / WRITE OUT SECOND UTILITY MENU BLOCK DLMUT3; ADMUT3; CDF 20; -DSMENU / WRITE OUT THIRD UTILITY MENU BLOCK 0 / END OF LIST INDICATOR /*************************************************************************** /**** PAGE ZERO LOCATIONS **** /*************************************************************************** FIELD 2 *100 / FIRST 100 LOCATIONS ARE USED FOR SYSTEM DSKBLK= .%400+DLUTL1 / DISK BLOCK WHERE PAGE IS LOADED CIFMYF= CIFBUF / DEFINE OUR FIELD. CDFMYF= CDFBUF / ... PR3= 6236 / FIRMWARE PANEL REQUEST #3 FOR DECMATE II BLDQR0, XX CIF 0 ENQUE BLDQB1 / QUEUE TO RXHAN BLDQR1, CIF 0 JWAIT / WAIT FOR DONE CLA TAD BLDQBK+RXQCOD SPA JMP BLDER / ERROR -1 VALUE SNA CLA JMP BLDQR1 JMP I BLDQR0 / DONE BLDER, CLA / HANDLE DISK DRIVE ERROR TAD BLDQBK+RXQDRV / GET THE ERROR DRIVE NUMBER AND BLDP7 / ISOLATE THE DRIVE NUMBER DCA BLDDRV / STORE THE ERROR DRIVE TAD BLDRWX / SET THE DEFAULT FUNCTION ADDRESS DCA BLDFNC / IT IS SET FOR READING TAD BLDQBK+RXQFNC / SEE IF IT IS READING AND BLDP77 / GET RID OF THE 4000 TAD BLDM2 / IF A 2 THEN IT IS A PHYSICAL WRITE SNA ISZ BLDFNC TAD BLDM2 / CHECK FOR A BLOCK WRITE SNA CLA ISZ BLDFNC CIFMNU JMS I IOACAL / THE ERROR MESSAGE 0 BLDERM 520 / POSITION ON THE SCREEN ROW 5 COL.20 BLDDRV, 0 / OUTPUT DRIVE OR DRIVE NUMBER WITH ERROR BLDFNC, 0 / READ/WRITE MESSAGE ADDRESS OR FUNCTION CODE BLDMSG, BLDBLK / DEFUALT IS BLOCK BLDNUM, BLDQBK+RXQBLK JMP I .+1 / RETURN NORMALLY BLDERN BLDP7, 7 BLDP77, 77 BLDM2, -2 BLDRWX, BLDRWM BLDMIN, 0 / THE VALUE OF THE MINUTES BLDSEC, 0 / THE TEMP VALUE THAT DETECTS A CHANGE IN TIME BLDTYP, 0 / LOCATION FOR ACTIVATE FEATURE BUILD TYPE DRVTYP, 0 / LOCATION FOR STORING DISK DRIVE TYPE / 0 = S.D. 8", 1 = D.D. 8", 2 = RX50 5.25" BLDQB1, DSKQUE;0;0 BLDQBK, 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0 X=. / LOCATION OF FIRST FREE LOCATION ON PAGE /----------------------- PAGE /*************************************************************************** /**** START OF UTILITY BUILD PROGRAM **** /*************************************************************************** DSKBLK= .%400+DLUTL1 / DISK BLOCK WHERE PAGE IS LOADED / READ IN THE REST OF THE PROGRAM THAT DIDN'T GET LOADED BY THE WPCU2 OVERLAY BLDOPT, XX / ENTRY POINT FROM WP2CMF CMND CALL TO WPCU2 CLA / MAKE SURE THAT ACCUMULATOR IS CLEAR TAD (400) / GET STARTING BUFFER ADDRESS DCA BLDQBK+RXQBAD / SET UP BUFFER ADDRESS FOR TRANSFER TAD BLDMYF / GET CDF INSTRUCTION TO THIS FIELD DCA BLDQBK+RXQBFD / SET UP BUFFER FIELD FOR TRANSFER TAD (DLUTL2) / GET DISK BLOCK ADDRESS DCA BLDQBK+RXQBLK / SET UP DISK BLOCK FOR TRANSFER DCA BLDQBK+RXQDRV / SET UP SYSTEM DRIVE FOR TRANSFER TAD (-DSUTL2) / GET NEGATIVE NUMBER OF BLOCKS DCA X1 / SET UP COUNTER FOR TRANSFER TAD (RXERD+4000) / GET READ FUNCTION CODE DCA BLDQBK+RXQFNC / SET UP FOR A READ OPERATION / BEGIN LOOP TO READ IN REMAINDER OF PROGRAM CODE FROM DISK BLDLOP, JMS BLDQR0 / READ IN ONE DISK BLOCK TAD (400) / OFFSET TO NEXT MEMORY BLOCK ADDRESS TAD BLDQBK+RXQBAD / COMBINE WITH CURRENT MEMORY ADDRESS DCA BLDQBK+RXQBAD / STORE UPDATED MEMORY ADDRESS ISZ BLDQBK+RXQBLK / INCREMENT THE DISK BLOCK NUMBER ISZ X1 / INCREMENT THE DISK BLOCK COUNTER JMP BLDLOP / NOT DONE, GO TRANSFER THE NEXT BLOCK / PUT UP USER SELECTION MENU FOR BUILD OPTION AND DISK DRIVE BLDOVR, CIFMNU / SET BACK TO MENU FIELD JMS I MNUCAL / CALL OPTIONS MENU DLMUT1 / DISK BLOCK FOR MENU CDFMNU / SWITCH TO MENU FIELD TAD I (MUBUF+MNTMP3) / PICK UP TEMP 3 VALUE FROM MENU FIELD DCA BLDFNC / SAVE VALUE FOR BUILD FUNCTION CODE / FUNCTION = 0 FOR DICTIONARY UPDATE / FUNCTION = 1 FOR BUILD COMBINATION DISK / FUNCTION = 2 FOR BUILD ACTIVATE DISK / FUNCTION = 3 FOR BOOT RX-50 OPERATION TAD I (MUBUF+MNTMP4) / PICK UP TEMP 4 VALUE FROM MENU FIELD DCA BLDDRV / SAVE OUTPUT DRIVE NUMBER TAD I (MUBUF+MNTMP5) / PICK UP TEMP 5 VALUE FROM MENU FIELD DCA BLDTYP / SAVE ACTIVATE FEATURE BUILD TYPE BLDMYF, CDFMYF / SET BACK TO THIS FIELD / CHECK FOR A BOOT OPERATION AC7775 / SET UP TO CHECK FOR A BOOT OPERATION TAD BLDFNC / PICK UP BUILD FUNCTION CODE SZA CLA / DOES THE USER WANT TO BOOT THE RX-50'S ? JMP BLDSET / NO, GO SET THE DENSITY OF THE OUTPUT DISK / BOOT RX-50 DISK NUMBER ZERO ON A DECMATE II AC0000 / SET THE AC TO POINT TO DRIVE ZERO RXISEL / IOT TO SELECT DRIVE PAIR SPECIFIED BY AC11 AC0000 / CLEAR AC FOR PR3 REQUEST PR3 / ISSUE A PR3 REQUEST TO REBOOT THE SYSTEM 5 / REQUEST TYPE 7777 / TERMINATOR JMP BLDOVR / FOR DECMATE I SYSTEM ONLY (NO RX-50'S) / SET THE DENSITY OF THE OUTPUT DRIVE BLDSET, TAD (BLDBUF) / RESET POINTER TO BUFFER ADDRESS DCA BLDQBK+RXQBAD / STORE IN QUEUE BLOCK FOR TRANSFER TAD (BLDBLK) / SET UP MESSAGE FOR ... DCA BLDMSG / POSSIBLE BLOCK ERROR TAD BLDDRV / SET TO OUTPUT DRIVE DCA BLDQBK+RXQDRV / AND STORE IT DCA BLDQBK+RXQBLK / CLEAR DISK BLOCK NUMBER FOR ERROR REPORT TAD (RXEDN+4000) / GET AND SET DENSITY DCA BLDQBK+RXQFNC / FUNCTION CODE JMS BLDQR0 / DO IT .... TAD BLDQBK+RXQSPC / PICK UP AND SAVE DISK DRIVE TYPE DCA DRVTYP / 0 = S.D. 8", 1 = D.D. 8", 2 = RX50 5.25" / TEST FOR DICTIONARY UPDATE FUNCTION TAD BLDFNC / GET TYPE OF BUILD OPERATION SZA CLA / SKIP IF DICTIONARY UPDATE OPERATION JMP BLDDSK / GO BUILD OPTION DISKETTE CIFMNU / SWITCH TO THE MENU FIELD JMS I IOACAL / CALL DISPLAY ROUTINE 0 / DEFAULT OUTPUT ROUTINE BLDUSD / PRINT "UPDATING DICTIONARY DISKETTE" 0 / CURSOR POSITION TO CLEAR THE SCREEN 23 / CURSOR POSITION FOR "UPDATE" MESSAGE / READ THE HOME BLOCK OF THE DICTIONARY DISKETTE TAD (RXERD+4000) / SET UP READ FUNCTION DCA BLDQBK+RXQFNC AC0002 / SET THE BLOCK NUMBER TO TWO DCA BLDQBK+RXQBLK TAD BLDDRV / SET TO OUTPUT DRIVE DCA BLDQBK+RXQDRV JMS BLDQR0 / REQUEST THE READ / VERIFY THAT THE HOME BLOCK COMES FROM A DICTIONARY DISKETTE TAD (BLDDIC-1) / GET POINTER TO VALUES TABLE DCA X1 / SET UP AUTO INDEX REGISTER BLDVFY, TAD I X1 / PICK UP HOME BLOCK ADDRESS SNA / CHECK FOR END OF TABLE JMP BLDUPD / EVERYTHING MATCHES, GO UPDATE BLOCK TAD (BLDBUF) / GENERATE POINTER INTO BUFFER DCA T1 / STORE ADDRESS FOR INDIRECT OPERATION TAD I T1 / PICK UP CONTENTS OF HOME BLOCK LOCATION CIA / NEGATE VALUE FOR COMPARE TAD I X1 / COMBINE WITH VALUE FROM TABLE SNA / CHECK FOR A MATCH /M001 JMP BLDVFY / THIS ONE MATCHED, GO CHECK NEXT ONE TAD (-10) / THE DIFFERENCE BETWEEN AN ASCII "US" /A001 / & A "UK" IS 8 (10 OCTAL) /A001 SZA CLA / SKIP IF THE DIFFERENCE WAS 8 /A001 JMP BLDVFERR / ELSE GO REPORT ERROR /A001 TAD X1 / NOW SEE IF THAT IS WHERE WE WERE LOOKING/A001 TAD (-BLDDCX) / /A001 SNA CLA / SKIP TO ERROR REPORT, THE DIFF. WAS 8 /A001 / BUT IT WAS JUST COINCIDENTAL /A001 JMP BLDVFY / "UK" MUST HAVE BEEN IN HOME BLOCK /A001 / INSTEAD OF "US", TREAT AS MATCH /A001 / ERROR DETECTED - DISKETTE IS NOT A DICTIONARY DISKETTE BLDVFERR, /A001 CIFMNU / SWITCH TO THE MENU FIELD JMS I IOACAL / CALL THE DISPLAY ROUTINE 0 / DEFAULT OUTPUT ROUTINE BLDNSD / PRINT "NOT SPELLING DICTIONARY DISKETTE" 1423 / CURSOR POSITION FOR "ERROR" MESSAGE JMP BLDERN / GO WAIT FOR USER RESPONSE / WRITE OUT MODIFIED HOME BLOCK OF THE DICTIONARY DISKETTE BLDUPD, JMS BLDHOM / UPDATE THE BUILD DATE IN HOME BLOCK JMS BLDPTR / SET UP POINTER INTO BUILD TABLE #2 /A002 ISZ X4 / BUMP POINTER PAST ACTIVATE NAME /A002 JMS BLDACT / YES, MOVE POINTERS INTO HOME BLOCK /A002 TAD (RXEWT+4000) / WRITE OUT THE NEW VERSION DCA BLDQBK+RXQFNC JMS BLDQR0 / REQUEST THE WRITE JMP BLDERN / ALL DONE, GO WAIT FOR USER RESPONSE X=. / LOCATION OF FIRST FREE LOCATION ON PAGE /----------------------- PAGE DSKBLK= .%400+DLUTL1 / DISK BLOCK WHERE PAGE IS LOADED / BEGIN BUILDING OPTION DISKETTE BY DISPLAYING ELAPSED TIME CLOCK BLDDSK, CDFMNU / SWITCH TO THE MENU FIELD DCA I (CLKCHG) / CLEAR THE TIME COUNTER CDFMYF / SWITCH BACK TO THIS FIELD DCA BLDSEC / CLEAR THE SECOND COUNTER DCA BLDMIN / AND THE MINUTES CIFMNU / SWITCH TO THE MENU FIELD JMS I IOACAL / CALL SYSTEM OUTPUT ROUTINE 0 / USE DEFAULT OUTPUT ROUTINE BLDSFD / PRINT "BUILDING SPECIAL DISKETTE" 0 / CURSOR POSITION TO CLEAR THE SCREEN 23 / CURSOR POSITION FOR "BUILD" MESSAGE 1232 / CURSOR POSITION FOR "CLOCK" MESSAGE BLDCLK / PRINT "ELAPSED TIME CLOCK 0:00" / SET UP MAXIMUM NUMBER OF BLOCKS ON OUTPUT DRIVE JMS BLDCLR / INITIALIZE BUFFER FOR BUILD OPERATION TAD DRVTYP / PICK UP DRIVE TYPE (0, 1, OR 2) CLL RAL / MULTIPLY VALUE BY TWO TAD (BLKTAB-1) / MAKE POINTER INTO BLOCK TABLE DCA X1 / STORE POINTER FOR INDIRECT TAD I X1 / PICK UP MAXIMUM NUMBER OF BLOCKS DCA X5 / STORE FOR LATER USE TAD I X1 / GET MAXIMUM NUMBER OF ALLOC WORDS DCA ALCNUM / INITIALIZE LOCATION IN ALLOCATION TEMPLET / CHECK FOR KIND OF BUILD OPERATION AC7776 / SET UP FOR A TEST OF FUNCTION TYPE TAD BLDFNC / GET USER SPECIFIED FUNCTION SZA CLA / CHECK FOR ACTIVATE DISK BUILD JMP BLDCHB / NO, GO INITIALIZE COMBINATION HOME BLOCK / CLEAR ALL DISK BLOCKS DCA BLDQBK+RXQBLK / CLEAR THE BLOCK COUNTER REGISTER TAD (RXEWT+4000) / SET UP WRITE OUT COMMAND DCA BLDQBK+RXQFNC / STORE FUNCTION CODE IN QUEUE BLOCK BLDLP1, JMS BLDQRX / WRITE THE NEXT BLOCK ISZ BLDQBK+RXQBLK / INCREMENT THE BLOCK NUMBER TAD BLDQBK+RXQBLK / PICK UP CURRENT BLOCK COUNT TAD X5 / COMBINE WITH MAX COUNT SZA CLA / HAS IT REACHED MAX YET ? JMP BLDLP1 / NO, MORE TO DO, GO AGAIN / INITIALIZE DISKETTE NAME IN HOME BLOCK TEMPLET FOR AN ACTIVATE DISKETTE JMS BLDPTR / SET UP POINTER INTO BUILD TABLE #2 /A002 AC7777 / SET UP FOR A DECREMENT TAD BLDADD / GET POINTER INTO DIRECTORY BLOCK DCA X1 / STORE POINTER IN AUTO INDEX REGISTER TAD (1616) / VALUE FOR TEXT "--" DCA I X1 / STORE FIRST VALUE IN DIRECTORY BLOCK TAD I X4 / PICK UP VALUE FOR DISK NAME DCA I X1 / STORE SECOND VALUE IN DIRECTORY BLOCK TAD (1616) / VALUE FOR TEXT "--" DCA I X1 / STORE THIRD VALUE IN DIRECTORY BLOCK JMP BLDINI / GO INITIALIZE VALUES / INITIALIZE DISKETTE NAME IN HOME BLOCK TEMPLET FOR COMBINATION DISKETTE BLDCHB, JMS BLDMOV / PUT FULL NAME INTO TEMPLET BLDTB1 / ADDRESS TO START MOVE FROM BLDADD, BLDDIR+2 / ADDRESS TO MOVE TO 3 / NUMBER OF WORDS TO MOVE / INITIALIZE VALUES TO BE WRITTEN IN BLOCK ZERO FOR COS COMPATIBILITY BLDINI, JMS BLDMOV / PUT FULL NAME INTO BUFFER BLDDIR+2 / ADDRESS TO START MOVE FROM BLDBUF+2 / ADDRESS TO MOVE TO 3 / NUMBER OF WORDS TO MOVE / WRITE BLOCK ZERO TO OUTPUT DRIVE DCA BLDQBK+RXQBLK / CLEAR THE BLOCK COUNTER TAD BLDDRV / SET TO OUTPUT DRIVE DCA BLDQBK+RXQDRV / AND STORE IT TAD (RXEWT+4000) / NOW WRITE THE NEW VERSION DCA BLDQBK+RXQFNC JMS BLDQRX / REQUEST THE WRITE / INITIALIZE VALUES TO BE WRITTEN INTO HOME BLOCK JMS BLDCLR / CLEAR BUFFER JMS BLDMOV / MOVE PARAMETERS INTO BUFFER BLDDIR / ADDRESS TO MOVE FROM BLDBUF / ADDRESS TO MOVE TO BLDDXX / NUMBER OF WORDS TO MOVE JMS BLDHOM / UPDATE THE BUILD DATE IN HOME BLOCK AC7776 / SET UP TO CHECK FOR ACTIVATE DISK TAD BLDFNC / COMBINE WITH BUILD FUNCTION CODE SNA CLA / CHECK FOR ACTIVATE FEATURES DISKETTE /C002 JMS BLDACT / YES, MOVE POINTERS INTO HOME BLOCK /A002 / NO, GO WRITE OUT THE HOME BLOCK /C002 / WRITE THE HOME BLOCK BLDHBW, TAD (DLDIR) / GET BLOCK NUMBER TO PUT IT OUT TO DCA BLDQBK+RXQBLK JMS BLDQRX / DO THE WRTIE JMP BLDCN1 / JUMP AND CONTINUE ON NEXT PAGE / ROUTINE FOR CALCULATING POINTER INTO BUILD TABLE 2 FOR ACTIVATE WORDS /A002 BLDPTR, XX / CALCULATE POINTER INTO BUILD TABLE #2 /A002 DCA T1 / CLEAR COUNTER REGISTER TAD BLDTYP / PICK UP ACTIVATE FEATURE TYPE SNA / CHECK FOR ZERO VALUE JMP BLDALL / YES, BUILD DISK TO ACTIVATE ALL FEATURES BLDLP2, CLL RAR / MOVE LEAST SIGNIFICANT BIT TO LINK ISZ T1 / INCREMENT THE OFFSET VALUE SNL / CHECK FOR A BIT IN THE LINK JMP BLDLP2 / LINK'S CLEAR, GO CHECK AGAIN CLA / CLEAR ANY POSSIBLE TRASH IN AC TAD T1 / PICK UP OFFSET VALUE FROM COUNTER CLL RTL / MULTIPLY VALUE BY FOUR BLDALL, TAD (BLDTB2-1) / COMBINE WITH BUILD TABLE ADDRESS DCA X4 / SAVE POINTER INTO BUILD TABLE JMP I BLDPTR / RETURN TO CALLER /A002 / ROUTINE FOR MOVING THE ACTIVATE WORDS INTO THE HOME BLOCK /A002 BLDACT, XX / STORE ACTIVATE WORDS IN HOME BLOCK /A002 TAD (BLDBUF+340-1) / SET UP POINTER INTO HOME BLOCK DCA X1 / STORE POINTER FOR ACTIVE WORDS TAD I X4 / PICK UP BIT PATTERN FOR ACTIVATE PROCESS DCA I X1 / STORE FIRST ACTIVE WORD IN HOME BLOCK TAD I X4 / PICK UP FIRST VERSION NUMBER DCA I X1 / STORE SECOND ACTIVE WORD IN HOME BLOCK TAD I X4 / PICK UP SECOND VERSION NUMBER DCA I X1 / STORE THIRD ACTIVE WORD JMP I BLDACT / RETURN TO CALLER /A002 / TABLE OF VALUES TO BE USED FOR DISK OPERATIONS DECIMAL / SET DECIMAL MODE BLKTAB, -632;-80 / RX01 SINGLE DENSITY BLOCKS AND ALLOC WORDS -988;-125 / RX02 DOUBLE DENSITY BLOCKS AND ALLOC WORDS -790;-99 / RX50 BLOCKS AND ALLOC WORDS OCTAL / RESET BACK TO OCTAL MODE / TABLE OF VALUES USED TO VERIFY DICTIONARY DISKETTE BLDDIC, 2 / LOCATION OF FIRST WORD OF NAME BLDDCX, 6664 / ASCII VALUE FOR "US" /M001 3 / LOCATION OF SECOND WORD OF NAME 4552 / ASCII VALUE FOR "DI" /M001 4 / LOCATION OF THIRD WORD OF NAME 4465 / ASCII VALUE FOR "CT" /M001 11 / LOCATION FOR NUMBER OF DOCUMENTS 7777 / MINUS ONE MEANS NO DOCUMENTS 0 / END OF TABLE VALUE X=. / LOCATION OF FIRST FREE LOCATION ON PAGE /----------------------- PAGE / WRITE THE ALLOCATION BLOCK BLDCN1, JMS BLDCLR / CLEAR BUFFER JMS BLDMOV / MOVE PARAMETERS INTO BUFFER BLDALC / ADDRESS TO MOVE FROM BLDBUF / ADDRESS TO MOVE TO BLDAXX / NUMBER OF WORDS TO MOVE TAD (DLALOC) / GET BLOCK NUMBER TO PUT IT OUT TO DCA BLDQBK+RXQBLK JMS BLDQRX / REQUEST WRITE FOR ALLOC BLOCK / CHECK TO SEE IF WE ARE BUILDING A UTILITY COMBINATION DISKETTE AC7777 / SET UP FOR A MINUS ONE VALUE TAD BLDFNC / COMBINE WITH USER SPECIFIED OPTION SZA CLA / CHECK FOR BUILD COMBINATION DISKETTE JMP BLDCHK / NO, IGNORE SOFTWARE TRANSFER ROUTINE / SET UP POINTERS FOR SOFTWARE TRANSFER TO UTILITY COMBINATION DISKETTE AC0002 / SET UP FOR AN OFFSET ADJUSTMENT TAD (BLDTB1) / COMBINE WITH POINTER TO DISK NAME DCA X1 / STORE IN AUTO INDEX REGISTER TAD I X1 / PICK UP INPUT DRIVE STARTING BLOCK NUMBER DCA T1 / STORE IN INPUT BLOCK NUMBER REGISTER TAD I X1 / PICK UP OUTPUT DRIVE STARTING BLOCK NUMBER DCA T2 / STORE IN OUTPUT BLOCK NUMBER REGISTER TAD I X1 / PICK UP COUNT OF NUMBER OF BLOCKS DCA T3 / STORE IN BLOCK COUNTER REGISTER / TRANSFER UTILITY SOFTWARE TO UTILITY DISKETTE BLDXFR, DCA BLDQBK+RXQDRV / SET TO DRIVE ZERO TAD T1 / PICK UP CURRENT INPUT DRIVE BLOCK NUMBER DCA BLDQBK+RXQBLK / STORE BLOCK NUMBER IN QUEUE BLOCK TAD (RXERD+4000) / PICK UP READ COMMAND DCA BLDQBK+RXQFNC / STORE COMMAND IN QUEUE BLOCK JMS BLDQRX / REQUEST THE READ COMMAND TAD BLDDRV / PICK UP NUMBER OF OUTPUT DRIVE DCA BLDQBK+RXQDRV / SET TO OUTPUT DRIVE TAD T2 / PICK UP CURRENT OUTPUT DRIVE BLOCK NUMBER DCA BLDQBK+RXQBLK / STORE BLOCK NUMBER IN QUEUE BLOCK TAD (RXEWT+4000) / PICK UP WRITE COMMAND DCA BLDQBK+RXQFNC / STORE COMMAND IN QUEUE BLOCK JMS BLDQRX / REQUEST THE WRITE COMMAND ISZ T1 / INCREMENT INPUT DRIVE BLOCK NUMBER ISZ T2 / INCREMENT OUTPUT DRIVE BLOCK NUMBER ISZ T3 / INCREMENT BLOCK COUNT JMP BLDXFR / NOT DONE, GO AGAIN / READ ALL DISK BLOCKS TO VERIFY THIER INTEGRITY BLDCHK, DCA BLDQBK+RXQBLK / SET THE BLOCK TO ZERO TAD (RXERD+4000) / SET FOR READING DCA BLDQBK+RXQFNC BLDDV1, JMS BLDQRX / READ THE NEXT BLOCK ISZ BLDQBK+RXQBLK / INCREMENT THE BLOCK NUMBER TAD BLDQBK+RXQBLK / PICK UP CURRENT BLOCK COUNT TAD X5 / COMBINE WITH MAX COUNT SZA CLA / HAS IT REACHED MAX YET ? JMP BLDDV1 / NO, MORE TO DO, GO AGAIN BLDERN, CIFMNU / SWITCH TO MENU FIELD JMS I IOACAL / CALL DISPLAY ROUTINE 0 / DEFAULT OUTPUT ROUTINE BLDRET / ADDRESS "PRESS RETURN" MESSAGE 2332 / CURSOR POSITION TO DISPLAY MESSAGE 2700 / MOVE CURSOR TO BOTTOM OF SCREEN / THIS ROUTINE WILL WAIT FOR A GOLD MENU OR RETURN TO BE TYPED BY THE USER. / A GOLD MENU OR A RETURN WILL CAUSE A RETURN TO THE BUILD DISKETTE MENU. / ALL OTHER CHARACTERS WILL RING THE BELL. JMP BLDWFR / CHECK FOR CHARACTER FROM THE KEYBOARD CIF 0 / CHANGE TO USER FIELD ZERO JWAIT / WAIT FOR SYSTEM INTERRUPT BLDWFR, CIF 0 / CHANGE TO USER FIELD ZERO XLTIN / READ THE KEYBOARD JMP .-4 / IF NOTHING TYPED THEN WAIT TAD (-EDMENU) / CHECK FOR A GOLD MENU SZA TAD (EDMENU-EDNWLN) / NOW CHECK FOR A RETURN SNA CLA JMP BLDOVR / GOLD MENU OR RETURN WAS TYPED / GO TO BUILD MENU / THIS ROUTINE WILL RING THE BELL IN RESPONSE TO SOME USER ERROR TAD (7) / GET ASCII BELL CODE JMP .+3 / SKIP OVER WAIT COMMAND CIF 0 / CHANGE TO USER FIELD ZERO JWAIT / WAIT FOR SYSTEM INTERRUPT CIF 0 / CHANGE TO USER FIELD ZERO TTYOU / TRY TO TYPE THE CHARACTER JMP .-4 / NOT SUCCESSFUL - GO TRY AGAIN JMP BLDWFR / GO BACK FOR ANOTHER CHARACTER X=. / LOCATION OF FIRST FREE LOCATION ON PAGE /----------------------- PAGE DSKBLK= .%400+DLUTL1 / DISK BLOCK WHERE PAGE IS LOADED / ROUTINE TO CLEAR THE BUFFER BLDCLR, XX / CLEAR THE BUFFER ROUTINE TAD (-400) / SET THE COUNTER FOR THE BUFFER DCA X1 TAD (BLDBUF-1) / SET THE ADDRESS OF THE BUFFER DCA X2 TAD (COSCNT) / FIRST WORD FOR COS COMPATABILITY BLDLUP, DCA I X2 / CLEAR THE NEXT LOCATION ISZ X1 / INCREMENT THE COUNTER JMP BLDLUP JMP I BLDCLR / RETURN TO CALLER / ROUTINE TO READ AND WRITE DISK BLOCKS BLDQRX, XX / DO DISK OPERATION AND UPDATE TIME CLOCK JMS BLDQR0 / REQUEST DISK OPERATION CDFMNU / SWITCH TO THE MENU FIELD TAD I (CLKCHG) / PICK UP FLAG FOR TIME CHANGE CDFMYF / SWITCH BACK TO THIS FIELD SPA / HAS THE TIME CHANGED ? JMP BLDTM4 / NO, RETURN TO CALLER BLDTM1, ISZ BLDSEC / INCREMENT SECOND COUNT TAD (-12) / SUBTRACT OFF A SECOND'S WORTH OF CHANGE SMA / DID MORE THAN A SECOND GO BY ? JMP BLDTM1 / YES, GO INCREMENT THE SECOND COUNT CDFMNU / SWITCH TO THE MENU FIELD DCA I (CLKCHG) / STORE NEW VALUE FOR CLOCK FLAG CDFMYF / SWITCH BACK TO THIS FIELD TAD BLDSEC / COMPUTE NEW TIME - GET SECOND COUNT BLDTM2, TAD (-74) / SUBTRACT OFF A MINUTE'S WORTH OF CHANGE SPA / DID WE CROSS THE MINUTE LIMIT ? JMP BLDTM3 / NO, GO RESTORE THE SECOND COUNT ISZ BLDMIN / YES, INCREMENT THE MINUTE COUNT JMP BLDTM2 / GO CONTINUE THE CHECK BLDTM3, TAD (74) / RESTORE THE SECOND COUNT DCA BLDSEC / STORE UPDATED SECOND COUNT CIFMNU / SWITCH TO MENU FIELD JMS I IOACAL / PRINT TIME WHEN IT CHANGES 0 / USE DEFAULT OUTPUT ROUTINE BLDTMT / TIME MESSAGE 1257 / SCREEN POSITION FOR TIME BLDMIN / VALUE FOR MINUTES BLDSEC / VALUE FOR SECONDS BLDTM4, CLA / NEEDED BECAUSE OF THE "SPA - JMP" ABOVE JMP I BLDQRX / RETURN TO CALLER / ROUTINE TO MOVE A BLOCK OF MENORY WITHIN THIS FIELD / CALL IS AS FOLLOWS: / / JMS BLDMOV / CALL MOVE ROUTINE / ADDRESS OF FROM / DEFINE FROM ADDRESS / ADDRESS OF TO / DEFINE TO ADDRESS / NUMBER TO MOVE / DEFINE NUMBER OF WORDS TO MOVE / RETURN / NORMAL RETURN ADDRESS BLDMOV, XX AC7777 / SET A.C. EQUAL TO MINUS ONE TAD I BLDMOV / SUBTRACT ONE FROM THE FROM ADDRESS ISZ BLDMOV / INCREMENT RETURN ADDRESS DCA X0 / STORE VALUE IN AUTOINDEXING REGISTER AC7777 / SET A.C. EQUAL TO MINUS ONE TAD I BLDMOV / SUBTRACT ONE FROM THE TO ADDRESS ISZ BLDMOV / INCREMENT RETURN ADDRESS DCA X1 / STORE VALUE IN AUTOINDEXING REGISTER TAD I BLDMOV / GET VALUE FOR NUMBER OF WORDS ISZ BLDMOV / INCREMENT RETURN ADDRESS CIA / MAKE THE VALUE NEGATIVE DCA X2 / STORE VALUE IN AUTOINDEXING REGISTER BLDMOR, TAD I X0 / GET MEMORY VALUE FROM "FROM" ADDRESS DCA I X1 / STORE MEMORY VALUE IN "TO" ADDRESS ISZ X2 / INCREMENT NUMBER OF WORDS TO TRANSFER JMP BLDMOR / NOT DONE, GO DO SOME MORE JMP I BLDMOV / RETURN BACK TO CALLER / ROUTINE TO INITIALIZE VALUES TO BE WRITTEN INTO HOME BLOCK BLDHOM, XX / INITIALIZE HOME BLOCK VALUES CDFSYS / GET A UNIQUE VALUE FOR ... TAD I (RANDOM) / DISKETTE IDENTIFICATION CDFMYF / SWITCH BACK TO THIS FIELD DCA BLDBUF+5 / SAVE IT IN THE HOME BLOCK TAD (BLDDY^100+BLDMO) / GET DAY AND MONTH OF BUILD DCA BLDBUF+7 / SAVE IT IN THE HOME BLOCK TAD (BLDYR) / GET YEAR OF BUILD DCA BLDBUF+10 / SAVE IT IN THE HOME BLOCK JMP I BLDHOM / RETURN TO CALLER X=. / LOCATION OF FIRST FREE LOCATION ON PAGE /----------------------- PAGE DSKBLK= .%400+DLUTL1 / DISK BLOCK WHERE PAGE IS LOADED BLDTB1, 7061; 6466; 6555 / COMBINATION DISKETTE NAME - WPSUTL ... DLUTLS; DLUTLS; -DSUTLS / ...INPUT & OUTPUT DISK BLOCK & MINUS SIZE BLDTB2, 4255; 1777; 6065; 6365 / AL - 0 - 0.5 - 3.5 - ACTIVATE ALL FEATURES 6242; 0001; 6271; 6371 / QA - 1 - 2.9 - 3.9 - Q.A. TEST FUNCTION 4456; 0002; 6065; 6365 / CM - 2 - 0.5 - 3.5 - COMMUNICATIONS 5561; 0004; 6065; 6365 / LP - 3 - 0.5 - 3.5 - LIST PROCESSING 6463; 0010; 6065; 6371 / SR - 4 - 0.5 - 3.9 - MULTI KEY SORT 5642; 0020; 6065; 6371 / MA - 5 - 0.5 - 3.9 - L.P. & EDITOR MATH 6445; 0040; 6065; 6371 / SD - 6 - 0.5 - 3.9 - SPELLING CORRECTOR 7061; 0100; 6271; 6371 / WP - 7 - 2.9 - 3.9 - NOT VALID FUNCTION 7061; 0200; 6271; 6371 / WP - 8 - 2.9 - 3.9 - NOT VALID FUNCTION 7061; 0400; 6271; 6371 / WP - 9 - 2.9 - 3.9 - NOT VALID FUNCTION 7061; 1000; 6271; 6371 / WP - 10 - 2.9 - 3.9 - NOT VALID FUNCTION 7061; 2000; 6065; 6365 / WP - 11 - 0.5 - 3.5 - DEVELOPMENT OPTIONS 7061; 4000; 6271; 6371 / WP - 12 - 2.9 - 3.9 - RESERVED FOR EXTENSION BLDDIR, COSCNT / HOME BLOCK DIRECTORY 130 / VERSION 1 0 / OPTION DISKETTE NAME - WORD ONE 0 / OPTION DISKETTE NAME - WORD TWO 0 / OPTION DISKETTE NAME - WORD THREE 0 / THE UNIQUE DISKETTE NUMBER WHICH IS "RANDOM" DLALOC / BLOCK NUMBER OF ALLOC BLOCK 0;0 / CREATE DATE -1 / NUMBER OF FILES BLDDXX=.-BLDDIR / DEFINE LENGTH OF DIRECTORY TABLE BLDALC, COSCNT / BLOCK ALLOCATION DIRECTORY 40 / ALLOC BLOCK - 0 MEANS DOCUMENT DISKETTE DECIMAL 0 / NUMBER OF BLOCKS IN FILE SYSTEM 0 / NUMBER OF FREE BLOCKS TO START ALCNUM, 0 / NUMBER OF ALLOC WORDS OCTAL BLDAXX=.-BLDALC / DEFINE LENGTH OF ALLOC BLOCK TABLE / THESE ARE THE CONSTANTS AND ADDRESSES USED BY THE ERROR MESSAGE. BLDRWM, BLDRED / THE ADDRESS OF THE STRING THAT SAYS READ BLDWRT / THE ADDRESS OF THE WRITE MESSAGE STRING BLDWRT, TEXT 'WRITE' BLDRED, TEXT 'READ' BLDBLK, TEXT 'BLOCK' BLDTRK, TEXT 'TRACK' BLDTMT, TEXT '^P!D:!2D' BLDUSD, TEXT '^P!E^P-- &UPDATING &SPELLING &DICTIONARY &DISKETTE --' BLDNSD, TEXT '^P!&ERROR - &NOT &VALID &SPELLING &DICTIONARY &DISKETTE' BLDSFD, TEXT '^P!E^P-- &BUILDING &SPECIAL &FEATURE &DISKETTE --^P^S' BLDCLK, TEXT '!&ELAPSED !&TIME !&CLOCK 0:00' BLDERM, TEXT '^P&ERROR ON DRIVE ^D WHILE TRYING TO !S ^S !D!E' BLDRET, TEXT '^P&PRESS !&RETURN TO CONTINUE^P' BLDBUF, ZBLOCK 400 BLDEND=. / LAST LOCATION USED THIS FIELD /*************************************************************************** /**** FIRST MENU PAGE FOR UTILITY BUILD PROGRAM **** /*************************************************************************** RELOC / RESET RELOCATION COUNTER ADMUT1=. / MEMORY ADDRESS FOR MENU BLOCK DSKBLK=DLMUT1 / DISK BLOCK WHERE MENU IS LOADED RELOC 0 / FIRST MENU BLOCK FOR UTILITY PROBRAM UT1ST, DISP;0;TEXT '!E--^S!&SPECIAL !&FEATURE^S --';CAPBLD;CAPDSK DISP;524;TEXT '&VERSION ^A &DATED !2D-!2D-!2D' UT1LST;BLDMON;BLDDAY;BLDYER DISP;1120;TEXT '&A = ^S&ACTIVATE &FEATURE ^S';TXTBLD;TXTDSK DISP;1320;TEXT '&B = &BOOT !&RX-50 &SYSTEM ^S';TXTDSK DISP;1520;TEXT '&D = &UPDATE &SPELLING &DICTIONARY ^S';TXTDSK DISP;1720;TEXT '&U = ^S&UTILITY &COMBINATION ^S';TXTBLD;TXTDSK UT1ERR, DISP;2424;TEXT '!E&TYPE THE LETTER^S';TXTPRS CLRV;STOV;MNTMP5 / CLEAR ACCUMULATOR AND BUILD TYPE READ;MNTMP1;UT1ERR / GET A RESPONSE FROM THE USER ARG;UT1ST;MNTMP1 / CHECK FOR A NULL RESPONSE KEYWRD TEXT 'A ';UT1A / USER SELECTED ACTIVATE DISK BUILD TEXT 'B ';UT1B / USER SELECTED BOOT SYSTEM DISKETTE TEXT 'D ';UT1D / USER SELECTED DICTIONARY UPDATE TEXT 'U ';UT1U / USER SELECTED UTILITY DISK BUILD GOTO;UT1ERR / INVALID RESPONSE, HANDLE ERROR UT1B, INCV / (3) HERE FOR BOOT SYSTEM DISKETTE UT1A, INCV / (2) HERE FOR ACTIVATE DISKETTE UT1U, INCV / (1) HERE FOR COMBINATION DISKETTE UT1D, STOV;MNTMP3 / (0) HERE FOR DICTIONARY UPTATE CASE;MNTMP3;3;UT1RET / TRAP FOR BOOT OPERATION TRNSFR;UT2RD;DLMUT2 / GO CONTINUE ON NEXT PAGE UT1RET, RETURN / GO BOOT THE SYSTEM DISK UT1LST, SYSVER; ". / DISPLAY SYSTEM VERSION NUMBER SYSBAS; ". / DISPLAY SYSTEM BASE LEVEL NUMBER SYSREV; 0 / DISPLAY BASE LEVEL REVISION NUMBER BLDDAY, BLDDY / DAY SOFTWARE WAS BUILT BLDMON, BLDMO / MONTH SOFTWARE WAS BUILT BLDYER, BLDYR / YEAR SOFTWARE WAS BUILT TXTBLD=.+1 / OFFSET FOR BUILD TEXT WORD CAPBLD, TEXT ' !&BUILD ' / TEXT FOR CAPITALIZED BUILD WORD TXTDSK=.+1 / OFFSET FOR DISKETTE TEXT WORD CAPDSK, TEXT ' !&DISKETTE' / TEXT FOR CAPITALIZED DISKETTE WORD TXTPRS, TEXT ' AND PRESS !&RETURN' XTRUT1=400-. IFZERO .-401&4000 /*************************************************************************** /**** SECOND MENU PAGE FOR UTILITY BUILD PROGRAM **** /*************************************************************************** RELOC / RESET RELOCATION COUNTER ADMUT2=. / MEMORY ADDRESS FOR MENU BLOCK DSKBLK=DLMUT2 / DISK BLOCK WHERE MENU IS LOADED RELOC 0 / SECOND MENU BLOCK FOR UTILITY PROBRAM UT2RD, DISP;1110 TEXT '!E&TYPE THE NUMBER OF THE DRIVE THAT CONTAINS THE^S';UT2DSK DISP;1310;TEXT 'TO BE INITIALIZED AND PRESS !&RETURN' UT2RD1, READ;MNTMP1;UT2RTN / GET A RESPONSE FROM THE USER ARG;UT2RTN;MNTMP1 / CHECK FOR A NULL RESPONSE NUMBER;MNTMP4;UT2ERR / CHECK FOR A NUMBER RANGE;MNTMP4;1;3;UT2ERR / CHECK FOR A VALID DRIVE NUMBER CASE;MNTMP3 0;-1-UT3SED;DLMUT3 / CHECK FOR DICTIONARY UPDATE FUNCTION /A002 2;UT2BLD / CHECK FOR BUILD ACTIVATE DISK OPTION RETURN / GOT EVERYTHING, RETURN TO CALLER UT2RTN, TRNSFR;UT1ST;DLMUT1 / RETURN BACK TO MAIN UTILITY MENU UT2ERR, DISP;2715;TEXT '&VALID DRIVE NUMBERS ARE 1, 2, AND 3' GOTO;UT2RD1 UT2BLD, DISP; 500;TEXT '!E' DISP; 520;TEXT '&A = ^S- &ACTIVATE !&ALL &FEATURES -^S';UT2BUI;UT2DSK DISP; 720;TEXT '&C = ^S&COMMUNICATIONS^S';UT2BUI;UT2DSK DISP;1120;TEXT '&D = ^S&SPELLING &CORRECTOR^S';UT2BUI;UT2DSK DISP;1320;TEXT '&L = ^S&LIST &PROCESSING^S';UT2BUI;UT2DSK DISP;1520;TEXT '&M = ^S&L.&P. AND &EDITOR &MATH^S';UT2BUI;UT2DSK DISP;1720;TEXT '&S = ^S&MULTI &KEY &SORT^S';UT2BUI;UT2DSK DISP;2120;TEXT '&T = ^S&Q. &A. &TEST^S';UT2BUI;UT2DSK TRNSFR;UT3S;DLMUT3 / CONTINUE ON NEXT PAGE UT2BUI, TEXT '&BUILD ' / BUILD TEXT FOR ABOVE MESSAGES UT2DSK, TEXT ' &DISKETTE ' / DISKETTE TEXT FOR ABOVE MESSAGES XTRUT2=400-. IFZERO .-401&4000 /*************************************************************************** /**** THIRD MENU PAGE FOR UTILITY BUILD PROGRAM **** /*************************************************************************** RELOC / RESET RELOCATION COUNTER ADMUT3=. / MEMORY ADDRESS FOR MENU BLOCK DSKBLK=DLMUT3 / DISK BLOCK WHERE MENU IS LOADED RELOC 0 / THIRD MENU BLOCK FOR UTILITY PROBRAM UT3S, DISP;2505;TEXT '!E&TYPE THE &LETTER FOR THE &FEATURE TO BE BUILT' DISP;-1;TEXT ' AND &PRESS !&RETURN, OR' DISP;2605;TEXT '&JUST &PRESS !&RETURN TO RECALL THE &MAIN &MENU.' UT3RD, READ;MNTMP1;UT3RTN / READ CHARACTERS FROM KEYBOARD ARG;UT3RTN;MNTMP1 / GET POINTER TO CHARACTER & XFER IF NULL KEYWRD TEXT 'A ';UT3ALL / ALL FEATURES DISKETTE TEXT 'C ';UT3COM / COMMUNICATION DISKETTE TEXT 'D ';UT3SED / SPELLING DETECTION DISKETTE TEXT 'L ';UT3LP / LIST PROCESSING DISKETTE TEXT 'M ';UT3MA / L.P. AND EDITOR MATH DISKETTE TEXT 'S ';UT3SR / SORT DISKETTE TEXT 'T ';UT3TST / Q. A. TEST DISKETTE TEXT 'U ';UT3UD / DEVELOPMENT OPTION - UPDATE DICTIONARY GOTO; UT3S / ERROR - CHARACTER HAS NO MEANING UT3RTN, TRNSFR;UT1ST;DLMUT1 / GO BACK TO MAIN UTILITY MENU UT3ALL, SET;0;MNTMP5 / SET UP FOR ACTIVATING ALL FEATURES RETURN / RETURN TO UTILITY MODULE TO BUILD DISKETTE UT3COM, SET;COMBIT;MNTMP5 / SET UP FOR COMMUNICATIONS DISKETTE RETURN / RETURN TO UTILITY MODULE TO BUILD DISKETTE UT3SED, SET;SEDBIT;MNTMP5 / SET UP FOR SPELLING DETECTION DISKETTE RETURN / RETURN TO UTILITY MODULE TO BUILD DISKETTE UT3LP, SET;LPBIT;MNTMP5 / SET UP FOR LIST PROCESSING DISKETTE RETURN / RETURN TO UTILITY MODULE TO BUILD DISKETTE UT3MA, SET;MABIT;MNTMP5 / SET UP FOR L.P. AND EDITOR MATH DISKETTE RETURN / RETURN TO UTILITY MODULE TO BUILD DISKETTE UT3SR, SET;SRBIT;MNTMP5 / SET UP FOR SORT DISKETTE RETURN / RETURN TO UTILITY MODULE TO BUILD DISKETTE UT3TST, SET;HWDBIT;MNTMP5 / SET UP FOR Q. A. DISKETTE RETURN / RETURN TO UTILITY MODULE TO BUILD DISKETTE UT3UD, SET;DEVBIT;MNTMP5 / SET UP FOR DEVELOPMENT DISKETTE RETURN / RETURN TO UTILITY MODULE TO BUILD DISKETTE XTRUT3=400-. IFZERO .-401&4000   /WPSPEL.PA / ******* EDIT HISTORY ******* / / 019 rcme 22-May-85 Adapt to multinational characters in personal / dictionaries. Fix DEL CHAR/Tech character bug. / / -------------------- All below refer to V2.0 and earlier -------------------- / / 018 WJY 07-NOV-84 Fix bug which caused XPU port patches to be / done on a dictionary block / 017 WJY 26-OCT-84 Eliminate file name display while user dictnry / is loading to prevent possible wrong name / from being displayed (WPSV2-315). / 016 WJY 25-OCT-84 Fix bug induced in edit 15 which causes the UD / operation to run when SC/LU should.(&vice versa?) / 015 WJY 22-OCT-84 Report document open failure to user (WPSV2-240). / 014 WJY 18-OCT-84 Change all occurrences of LINCOL to SPLINC / to eliminate conflict in name with new symbol / defined in WPEDIT. / 013 WJY 28-AUG-84 Support larger Z80 ram files / 012 WJY 21-AUG-84 Enable "Add New Word" functionality w/o / new word list full message. / 011 WJY 18-AUG-84 Fix bug which caused words followed by a period / to miss possible corrections. / 010 WJY 14-AUG-84 More "Update Personal Dictionary" / 009 WJY 07-AUG-84 Reduce max word length to 31 to prevent HM code / from dying. Bug WPSV2-156 / 008 WJY 24-JUL-84 Add "Update Personal Dictionary" functionality / 007 WJY 21-JUL-84 Delete debugging halt accidentally installed / in base level. / 006 WJY 13-JUL-84 "Undelete" commented out code for XPU reset / sequence. Unnecessary in pass 1 boards but / needed for pass 2. Production boards ??? / 005 WJY 12-JUN-84 Eliminate the "Working" message & add / additional XPU comments. / 004 WJY 29-MAY-84 XPU & single American/British Utility disk / support. / 003 WCE 23-APR-84 Eliminated second QURX routine in Field TWO / 002 WJY 06-APR-84 Unbundle Spelling Corrector / 001 GDH/EH AUG/SEP-83 Initial version / FIELD 0 / Write out code. *200 / Set up for write-out. JMP I .+2 JMP I .+2 RXLOAD 7605 *RXLDLS RXEWT;0;RXQBLK;. IFNDEF DECDEV < DLOSPL;100;CDF 20;-DSOSPL / Write-out primary spell-check code. > IFDEF DECDEV < DLOSPL;100;CDF 40;-DSOSPL > DLOSPX;200;CDF 30;-DSOSPX / Writeout auxillary IOA & text code. 0 IFNDEF DECDEV < FIELD 2 / Assemble SPELLING CHECKER code into field 3. > IFDEF DECDEV < FIELD 4 > CDFSPL=CDFMTH CIFSPL=CIFMTH CDISPL=CDIMTH CDFMYF=CDFSPL CDFTXT=CDFLP / Text field is field 5. CIFTXT=CIFLP / ... CDITXT=CDILP / / Page 0 values. *100 SCURSR, 0 / Saved CURSOR value for start of word. SCURPT, 0 / Saved CURPTR value for start of word. HYPHEN, 0 / - ==> scan 'till hyphen seen. / 0 ==> no hyphen seen. / + ==> word is hyphenated. LINCNT, 0 / # of lines word crosses. CHAR, 0 / Saved char from TSTCHR routine. NOTWRD, 0 / "NOT WORD" indicator. <> 0 means NOT A WORD. WRDSIZ, 0 / Word size thus far. DISATR, 0 / Contains attributes word for REPLACE replacement words. NEWLIN, 0 / Flag to indicate that a NEW LINE has been scrolled. SLCRSR, 0 / CURSOR value of 1st word on current line. ELINCT, 0 / counter as to which line user is on during EDIT. RLINCT, 0 / counter as to which line is the restart line. UNDLCT, 0 / count of # of characters in undeleted buffer. NOINSR, 0 / <> 0 when INSERT not allowed. NOMORE, 0 / <> 0 when at end of current line. ECMODE, 0 / current MODE of EDIT processing. ECERFL, 0 / <> 0 When there is an error msg being displayed. OFFSET, 0 / pointer to the option requested WDOFST, 0 / pointer to the correct word requested LEVEL, 0 / active menu line: 0/corr. list, 1/menu INPCHR, 0 / char input by user to menu CURLSZ, 0 / current logical size of correct word list RTNSTS, 0 / return status code SIXTEN, 16 / row 16 P137, 137 / 7-bit mask to uppercase M107, -107 / minus (107) LNCLMR, 0 / line & column # of <.......> text TMPWRD, 0 / temp location WRD, 0 / pointer to start of word ROW, 0 / row correct words are being displayed on WRDCNT, 0 / counter of number of words NUMTRY, 0 / number of times user reaches end of C.W.L WDSAVL, 0 / if set, word not found in dictionary HLPLEN, -110 / number of 'spaces' in the HELP header VIDEO, 0 / 1 if error word is highlighted, 0 if not. / Set/Cleared by DISPLY. HALTFG, 0 / GOLD:HALT flag. Set if GOLD:HALT detected. UPDCLK, 0 / If set, WTLOOP will update the screen clock. STRTAH, 1&377 / high byte starting address to load Z80 from STRTAL, 0&377 / low byte starting address to load Z80 from GTAPU1=400 / starting address to go to ( 100 hex ) INIUSR, 0 / -1 for SC, 0 for LU (loading user dict'ry),/M008 / >0 for UD (update user dict'ry) /A008 HOLDCH, 0 / temp for DISWRD routine. FILNUM, 0 / file # the APU should be reading from CORACT, 0 / CORrector ACTivated flag: /A002 / =1 if Spelling Corrector Option active/A002 / =0 otherwise (any other value INVALID)/A002 XPUFLG, 0 / True when the external processor is an XPU/A004 MSTRLX=-2 / Master lexicon file: file # 2 RAMFIL=-3 / RAM load file: file # 3 HMCODE=620 / Block # where Houghton-Mifflin code starts/M013 UPDICT=1 / *TEMPORARY* activates add new word.. /A012 SLNMOD=JMS I .;ECSLMD / Spell Check equivalent of some editor routines. ADVPTR=JMS I .;ECAPTR / ... BKPPTR=JMS I .;ECBPTR / INSCHR=JMS I .;ECICHR / INSERT (not same as EDITOR INSCHR) GETCHR=JMS I .;ECGCHR / CURMOV & LODCHR MOVCHR=JMS I .;CRSTMV / CURMOV only. LOADCH=JMS I .;ECLOAD / LODCHR UPDSCN=JMS I .;FXSCRN / FXSCRL CHKSCN=JMS I .;CKSCRN / TSTLIM & FXSCRL PUTCHR=JMS I .;PTCHRS / Output a string of 7 bit characters. CALEDT=JMS I .;CALLAR / Linkage to editor 'CALLAR' routine. /d009 MAXCHR=40 / Maximum size of word (32 decimal). MAXCHR=37 / Max. length=31 as temp fix for HM bug /A009 BUF0LEN=226 / length of correct word buffer (150 dec.) BUF1LEN=74 / length of table of correct words / (max. of 30 words, 2 entries/word) / Below are the equates associated with the APU protocol. / PCSTWD=1 / START word. PCENWD=2 / END word. PCADWD=3 / ADD word to user dictionary (IGNORE). PCRDBK=4 / READ block. PCWDOK=5 / Word FOUND and spelled correctly. PCWDNF=6 / Word NOT FOUND in dictionary. PCNXWD=7 / Get NEXT possible correct word(s). PCNOMR=10 / No more possible corrections. PCDONE=11 / Done ADD function. PCUSDF=12 / User dictionary FULL. PCUDFE=13 / Undefined Error. PCSTBK=14 / Start of block. PCENBK=15 / End of block. PCVRFY=16 / Verify last word. PCINUD=17 / Initialize user dictionary. PCDUPL=20 / Duplicate word in user dictionary. PCADNW=21 / ADD word to user dict. & new list (IGNORE)/A008 PCRTNW=22 / Return new user word list /A008 PCENNW=23 / End of new word list /A008 PCSS8B="%&177 / Single Shift an 8 bit character /a019 / / These are the IOT's associated with the APU & XPU / / APU XPU / ------ ------- Z80DF=6140 ;X80DF=6170 / Set APU outbound data available flag Z80SF=6141 ;X80SF=6171 / Skip next instruction if APU flag is set, / and clear flag. Z80RN=6142 ; / not used / Read APU outbound register, DO NOT clear/M005 / APU outbound read not finished flag. Z80RS=6143 ;X80RS=6173 / Read APU outbound register, clear APU / outbound read not finished flag. Z80NP=6144 / NOP. X80ST=6174 / Set selected bits in XPU status register/A005 Z80LI=6145 ;X80LI=6175 / Load APU interrupt enable. Z80WR=6146 ;X80WR=6176 / Write APU inbound register. Z80IF=6147 ;X80IF=6177 / Skip on APU inbound read complete flag, / and clear it. / / Bit definitions for send to APU / CDBIT=0400 / command XRBIT=1000 / transfer ready RBIT=4000 / reset / / Bit definitions for the XPU IOTs. / ATTNBIT=4000 / attention (X80ST) /A005 BKDNBIT=2000 / block transfer done " /A005 TIMRBIT=100 / 10 msec timer " /A005 RSETBIT=1000 / hardware reset (X80LI) /A005 /**************************************************************************** / ECDOIN Hook to the origional routine which will trap /a019 / any 8 bit characters input, and expand them to /a019 / dead things /a019 /**************************************************************************** ECDOIN, XX / Return address for 8 bit ECDOIN /a019 TAD T1 / Get the character /a019 CIFTXT / Change to field containing 8 bit code /a019 JMS ECIMCH / Call the routine /a019 JMP I ECDOIN / Return /a019 /----------- PAGE /------------------------------------------------------------------------/ / / NOTE: All FATAL errors, after being reported, jmp to EOF for final / cleanup. In order to catch the start-up errors, the entry point / and exit CDI are assembled to return to appropriate clean-up / code. / /------------------------------------------------------------------------/ SPELL, STRTGM / entry point to spelling checker. RDF / Get return data field. TAD CIDF0 / Make a return CID instruction. DCA SPLXIT / save for final return. CDFMYF / Back to our field. /d015 TAD INIUSR / See if SC or LU or UD /A008 /d015 SMA SZA CLA / It's SC or LU - SKIP /A008 CIFTXT / Go do initial checking /A015 JMS SPINCK / ... /A015 JMP UPDTPD / It's UD - Go update the user's dict. /A008 JMP SCNXT2 / PD or DS -merge below to get to 1st posn./M015 / Couldn't open file -just exit /A015 EOF, JMS CLRRGN / Clear scrolling region. SPLXIT, CDIEDT / Map return field. JMP I SPELL / Return to Menu (or where ever). / / return to here to ignore.... SCFIX moved edit no. 008 - space wars /M008 / / / merge here to scan to the start of the next word. / SCNEXT, CDFEDT / Re-enable ECHO while scanning to next word. AC0001 / ... DCA I (ECHFLG) / .... TAD I (SCRLCT) / Test screen lag. CDFMYF / SZA CLA / Skip if no lag. JMS UNDOLG / Update screen. SCNXT1, AC0001 / Move to next CURSOR position. SCNXT2, GETCHR / Get (next) character. JMP EOF / If we get EOF then we're done. AND P177 / Strip mode bits /a019 JMS TSTCHR / See if character is ALPHA-ONLY. JMP SCNXT1 / Jmp if no. Char must be a word separator. NOP / Allow words to begin w/ nuneric. TAD CHAR / Get character back. JMS TSTSPC / See if special (".", "-", or "'"). SNA CLA / Skip if none of those. JMP SCNXT1 / Don't allow those chars as introducers. / / found Start of Word. / CDFEDT / Map edit field. TAD I (CURSOR) / Save current context. DCA SCURSR / Current cursor posn. TAD I (CURPTR) / Save current text pointer. DCA SCURPT / ... DCA I (ECHFLG) / Turn off echo while scanning word. TAD I (SCRLCT) / Test screen lag to start of word. CDFMYF / Back to our field. SZA CLA / Skip if no lag. JMS UNDOLG / Undo screen lag (Call FXSCRL). TAD NEWLIN / has there been a new line since the start of / the last word? SNA CLA / Skip if yes. JMP SCNXT3 / JMP if no. TAD SCURSR / Save cursor of 1st word on the line. DCA SLCRSR / ... DCA NEWLIN / Reset new line seen flag. SCNXT3, DCA LINCNT / Init # of lines word is on. TAD (WRDBUF-1) / Init buffer to save chars in. DCA X0 / ... AC0001 / Set "NOT A WORD" flag to say that word DCA NOTWRD / is "NOT A WORD" (yet). DCA WRDSIZ / Init # of chars of word to none. DCA CHARCT / Init # of chars to send to APU to 0 /a019 TAD CHAR / Restore 1st character of word. MSLMRG, AND P377 / Isolate only the character bits. TAD (-ECMDFL) / Trap out stray Line Modified Flags /a019 SNA / Is this a line modified flag? /a019 JMP NEXTCH / Yes, ignore it /a019 TAD (ECMDFL) / No, restore character /a019 JMS TSTCHR / See if character is ALPHA-NUMERIC. JMP DONWRD / Exit loop if no. JMP MSLMG1 / Allow numeric. TAD CHAR / Get character. JMS TSTSPC / See if allowable special (".", "-", or "'"). SZA CLA / Skip if yes. DCA NOTWRD / Otherwise set "WORD IS A WORD" when see alpha. MSLMG1, TAD CHARCT / See if word buffer is full. TAD (-MAXCHR) / ... SMA CLA / Skip if no. JMP SCANWD / If yes, word is too long. Scan it. TAD CHAR / Get character back. X="-&177 TAD (-X) / Is character a hyphen? SZA CLA / Skip if yes. JMP NXTCH2 / no. continue below. TAD HYPHEN / What mode are we currently in? SPA CLA / Skip if 1st pass on word. JMP DNWRD2 / If 2nd pass, then stop on the hyphen. ISZ HYPHEN / Say that a hyphen has been seen. NXTCH2, TAD CHAR / Get character back. DCA I X0 / Save character in intermediate buffer. JMS TSTLIN / Check for word wrapped. CLA / Get rid off rubbish in AC /a019 TAD CHAR / Check for 8 bit character /a019 AND (200) / Is this an 8 bit character? /a019 SZA CLA / .... /a019 ISZ CHARCT / Yes, increase no of chars to Z80 to /a019 / include toggle character sent to APU /a019 ISZ WRDSIZ / 1 more char in word buffer. ISZ CHARCT / And 1 more char to send to Z80 /a019 NEXTCH, AC0001 / Move text ptr to next cursor posn. NXTCH1, GETCHR / Load character. JMP DONWRD / if EOF then we're done this word. AND P177 / Mask out mode bits /a019 JMP MSLMRG / Check out this character. CHARCT, 0 / Count of chars to be sent to Z80 /a019 /**************************************************************************** / GETZ8C Code here is placed around the old GETZ80 code to deal /a019 / with 8 bit characters form the Z80, which appear as /a019 / stripped 7 bit preceeded by a toggle character /a019 /**************************************************************************** GETZ8C, XX / Start routine with return address /a019 JMS GETZ80 / Use the old routine to get a char from/a019 TAD (-PCSS8B) / the Z80 APU. Check for the SS 8 bit /a019 SZA / Is it the single shift into 8 bit char?/a019 JMP GETZXT / No, just return the character /a019 JMS GETZ80 / Yes, get the next character /a019 TAD (200) / Set the 8th bit /a019 SKP / as is new character, skip toggle add /a019 GETZXT, TAD (PCSS8B) / Recover origional 7 bit character /a019 JMP I GETZ8C / Return /a019 /----------- PAGE SCANWD, AC7777 / Say that word (which is too long) is notaword. DCA NOTWRD / ... SCANLP, AC0001 / Move to next cursor position. GETCHR / Get next character. JMP EOF / Done at End of file. JMS TSTCHR / Check current character for ALPHA. JMP DONWRD / Terminator character. JMP SCANLP / Scan words with NUMERIC in them. JMP SCANLP / It is alpha. continue to scan. DONWRD, TAD HYPHEN / 1st pass? SPA CLA / Skip if yes. Leave HYPHEN indicator as set. DCA HYPHEN / Reset "STOP ON HYPHEN" flag. DNWRD2, TAD NOTWRD / Is word NOT A WORD? SZA CLA / Skip if NO (ie word is still a word). JMP WRDOK / Check HLT FLAG & then scan to next word. JMS TSTLIN / See if we word-wrapped. TAD X0 / Get ptr to last char of word. DONXXX, DCA BUFPTR / Save ptr to last char. TAD I BUFPTR / Get last char of word. JMS TSTSPC / See if special (".", "-", or "'"). SZA CLA / Skip if yes. JMP DONYYY / JMP if no. we're at the end of the word. TAD BUFPTR / Get ptr to last character of word. TAD (-WRDBUF) / See if we're at the start of the buffer. SNA / Skip if no. JMP WRDOK / If yes, then word is empty (& therefore OK). TAD (WRDBUF-1) / Backup the pointer by 1. JMP DONXXX / And try next character. DONYYY, TAD BUFPTR / Compute size of word. TAD (-WRDBUF+1) / ... DCA WRDSIZ / save it for those who need it. DCA I X0 / Set a stopper at the real end of the word. JMS SNDWRD / Send the word to the APU. JMS GETAPU / Get response back. -12 / Time-out max. - 10 seconds PCWDOK;WRDOK / Word is valid. Check HALT FLAG, then continue scanning. PCWDNF;NOTFND / Word is not in dictionary. PCDONE;WRDOK / Done adding word to user dictionary. PCUSDF;USDFUL / User dictionary full. PCDUPL;WRDOK / Word already in dictionary. Ignore error. 0 / No more valid return options. NOTFND, ISZ BUFPTR / Bump to the next character. TAD I BUFPTR / Get next character. X=".&177 / period character. TAD (-X) / See if next char is a period. SZA CLA / Skip if yes. JMP NTFND2 / JMP if no. handle "WORD NOT FOUND". ISZ WRDSIZ / Bump word size. JMS SNDWRD / Retry the word with the period. JMS GETAPU / get response. -12 / Time-out maximum - 10 seconds. PCWDOK;WRDOK / Word is valid after all. Check HALT FLAG, then continue. PCWDNF;NTFND1 / Word still isn't found. 0 / All other returns are fatal. BUFPTR, 0 / Ptr into word. WRDOK, CDFSYS / Check the HALT FLAG. TAD I HLTFLG / ... CDFMYF / .... SNA CLA / Skip if it's set. JMP SCNEXT / Halt flag not set. Continue scanning. ISZ HALTFG / Say that we GOLD:HALTed. AC7777 / Say that no word is highlighted. DCA VIDEO / ... JMP WRDERR / Merge to user menu. NTFND1, AC7777 / Bump size back down. Highlight the word TAD WRDSIZ / without the terminating period. DCA WRDSIZ / ... / Must use SNDWRD to tell HM that the /A011 / word it returns corrections for will /A011 / be "foo" not "foo." /A011 JMS SNDWRD / Send incorrectly spelt word w/o the period./M011 JMS GETAPU / Get response /A011 -12 / Time-out max. - 10 secs. /A011 PCWDNF;NTFND2 / Word was not found B4 so this is the /A011 0 / only kosher response /A011 NTFND2, TAD HYPHEN / Is word hyphenated? SMA SZA CLA / Skip if part of hyphenated word in error. JMP NTFND4 / Jmp if only done 1st pass on hyphenated word. CDFEDT / Now do a 'screen check' for 158 col mode. TAD I (CURSOR) / If word terminates in 2nd half TAD (-WIDTH) / then be sure that 2nd screen gets displayed. SMA CLA / Skip if word doesn't end in 2nd half. JMP NTFND3 / JMP if word ends in right-half screen. TAD SCURSR / Get start of word. Make sure that start-of- DCA I (CURSOR) / word half is mapped. NTFND3, CDFMYF / Back to our field. CHKSCN / Make sure right screen is displayed. TAD SCURSR / Restore CURSOR to point to start of word. CDFEDT / ... DCA I (CURSOR) / .... CDFMYF / back to our field. JMS DISPLY / Refresh word. 1 / flag to say SET REVERSE VIDEO. DCA HALTFG / Say that NOT stopped due to GOLD:HALT. WRDERR, JMP ERRGCOR / set up to display corrections.. / / return to here to continue..... / SCCONT, TAD VIDEO / Did we edit the line? SZA CLA / Skip if yes. Editting reset the restart point. JMP SCFIX / Didn't edit. Unhighlight word & continue. JMS ECPSCN / Position cursor to start of restart word. DCA NEWLIN / Say "still on same old line". JMP SCNXT2 / Rescan old word. /----------- PAGE /------- / /DISPLY - routine to redisplay currently selected word. / / This routine refreshes the text on the screen starting at SCURPT / for WRDSIZ characters. Screen / position of start of word is minus LINCNT (-LINCNT) lines from the / bottom of the screen. Column of start of word is SCURSR. / DISPLY, XX / entry point. TAD I DISPLY / Get address of type of video call. DCA VIDEO / save. ISZ DISPLY / bump return address. TAD WRDSIZ / Get size of word. CIA / Negate for IZZY loop. DCA DISCNT / ... DCA T2 / reset current attributes. JMS SETATR / ... AC7777 / In all attributes initially. DCA DISATR / ... JMS POSNCU / Position CURSOR & init EDT pointers. LOADCH / Load 1st character of word. XX / Should not get here. JMP DSPLY2 / Merge below w/ character. DSPLY1, ADVPTR / Advance CURPTR to next character. XX / should never get here. DSPLY2, TAD (-ECWWLN) / soft wrap? /m019 SNA / skip if no. JMP DSPLY4 / Yes. output CR LF sequence. TAD (ECWWLN-ECHYLN) / Is character SOFT-HYPHEN? SNA / Skip if no. JMP DSPLY3 / JMP if yes. output attributed hyphen & CRLF. TAD (ECHYLN-ECSTRL) / Start of ruler? SNA / Skip if no. JMP DSPLY5 / Skip over ruler. TAD (ECSTRL-ECJSPC) / Soft space? SNA / Skip if no. JMP DSPLY6 / Skip over soft space. TAD (ECJSPC) / Make character normal. JMS DSPLY7 / Check the attributes /a019 /d019 DCA T1 / Save character. /d019 TAD T1 / Get character. /d019 AND (1600) / Isolate attribute bits only. /d019 DCA T2 / Save temporarily /a019 /d019 TAD T2 / Retrieve again /a019 /d019 AND DISATR / AND with prior attributes. /d019 DCA DISATR / Set new attributes word. /d019 TAD T1 / Get character back. /d019 AND (1600) / Isolate attributes. /d019 DCA T2 / See if same as previous attributes. /d019 TAD T2 / ... /d019 CIA / ... /d019 TAD PRVATR / .... /d019 SZA CLA / Skip if yes. /d019 JMS SETATR / otherwise set new attributes. /d019 TAD T1 / Get character (with attributes). CIFEDT / Call routine in editor field to output char. CALEDT; PUTSCH / ... CDFEDT / .... TAD T1 / Get the last character back again /a019 TAD (-ECSTOV) / Test for it being a dead key sequence /a019 SZA CLA / Is this a dead key introducer? /a019 JMP DISNDK / No, don't display a dead key character/a019 DISADV, ADVPTR / Yes, skip the rest as PUTSCH displays /a019 XX / Should never get here /a019 TAD (-ECNDOV) / the whole thing on the first pass /a019 SNA / Is this the end of the dead sequence? /a019 JMP DISNDK / Yes, go deal with rest of word /a019 TAD (ECNDOV) / Restore the original character /a019 JMS DSPLY7 / Check the attributes /a019 JMP DISADV / Deal with next char in dead key /a019 DISNDK, TAD T2 / Get attributes back again /a019 AND DISATR / AND with prior attributes /a019 DCA DISATR / Set new attributes word /a019 ISZ DISCNT / See if done word yet. JMP DSPLY1 / Not at end yet. get next character. TAD VIDEO / Reverse video? SZA CLA / Skip if no. JMS CLRRV / Shut-off reverse video. CIFPRT / Shut-down BLKBOX routine. JMS I (BLKBOX) / ... JMP I DISPLY / Return to caller. DSPLY3, TAD ("-&177 / Get hyphen character. TAD PRVATR / Add on attributes of immediate prior character. CIFEDT / Call editor routine to output character. CALEDT; PUTSCH / ... CDFEDT / .... DSPLY4, PUTCHR; 4000+CR / Posn to start of next line. 0000+LF / .... CDFEDT / Reset column pointer to start of line. DCA I (CURPOS) / ... DSPL4A, CDFMYF / Back to our field. JMP DSPLY1 / Loop back to get next character. DSPLY5, ADVPTR / Scan an EDT buffer character. XX / Should never get here. TAD (-ECNDRL) / Is this the end of the ruler? SZA CLA / Skip if yes. JMP DSPLY5 / Scan to next character. JMP DSPLY4 / Skip to next line. DSPLY6, PUTCHR; 4000+ESC / advance cursor. 4000+"[ / ... 0000+"C / .... CDFEDT / Bump column pointer to next column. ISZ I (CURPOS) / ... JMP DSPL4A / Reset data field & process next char. DSPLY7, XX / Store and set new attributes routine /a019 DCA T1 / Save character /a019 TAD T1 / Get the character with the attributes /a019 AND (1600) / Mask out the attribute bits /a019 DCA T2 / Save in temporary register /a019 JMS STATR1 / Check against previous attributes and /a019 / change them if neccesary /a019 TAD T1 / Get character back /a019 JMP I DSPLY7 / Return /a019 PRVATR, 0 / Saved attributes of previous character. DISCNT, 0 / Count of # of chars in word. /**************************************************************************** / ECSCRL moved elsewere to make space for DISPLY to expand /a019 /**************************************************************************** /**************************************************************************** / SNDAPC This code has been put round the origional SNDAPU to /a019 / deal with 8 bit characters by proceeding them with a /a019 / toggle character /a019 /**************************************************************************** SNDAPC, XX / Start routine with return address /a019 DCA T3 / Save the character temporarily /a019 TAD T3 / Get it back /a019 AND (200) / Is it an 8 bit character /a019 SNA CLA / ? /a019 JMP CHROLY / No, send character only /a019 TAD (PCSS8B) / Yes, send a toggle character /a019 JMS SNDAPU / Send it via the old SNDAPU routine /a019 CHROLY, TAD T3 / Get the character back /a019 JMS SNDAPU / Sent it /a019 JMP I SNDAPC / Return to caller /a019 /------------ PAGE NTFND4, AC7777 / Set flag to stop at next hyphen DCA HYPHEN / and rescan the word. TAD LINCNT / Get # of lines to start of word. JMS ECSCRL / Scroll to the line in question. JMS ECINI2 / Posn cursor to start of word. DCA NEWLIN / Reset "still on same line" flag. JMP SCNXT2 / Start rescanning the word. /------------- / /ECOPTN - handle EDIT option for SPELLING CORRECTOR. / / This routine allows the user to EDit the line with the word in / question on it. The user is allowed a subset of full editting / capabilities. The user is not allowed to backup beyond the beginning / of the line, nor are they allowed to advance beyond the last word on / the line (which may cross multiple line boundries). / / /CALL: JMS ECOPTN (from USER MENU dispatcher). / rtn1 Return to take if the RETURN key is hit. / rtn2 Return to take if the GOLD:MENU key is hit. / /-------------- ECOPTN, XX / Entry point. ISZ INEDIT / Say that we're editing. TAD VIDEO / Is word currently displayed in RV mode? SZA CLA / Skip if no. Skip first time initialization. JMS ECINIT / Do edit command initialization stuff. JMS ECPSCN / Position cursor (for gold:menu exit & return). DCA UNDLCT / Clear out the DELETE buffer. DCA DISATR / Zero word attributes so ECIMCH works /a019 DCA ECMODE / Reset MODE to ADVANCE. JMS ECINI2 / Do rest of initialization. ECLOOP, CDFEDT / Get scroll count (if any). TAD I (SCRLCT) / ... CDFMYF / Back to our field. DCA T1 / save. TAD T1 / Get lag count. TAD ELINCT / Keep track which line we are on. DCA ELINCT / ... TAD T1 / Get lag count. TAD RLINCT / update distance to restart line. DCA RLINCT / ... CHKSCN / Update screen (call FXSCRL). JMS IPTCHR / Get next input character. / JWAIT until something available. DCA T1 / Save character for a bit. TAD ECERFL / Is there an error line to clear? SNA CLA / Skip if yes. JMP ECHECK / Jmp if no. continue below. JMS PUTERR / Output error line. BLANKL / blank line. DCA ECERFL / Say no error line being displayed. ECHECK, TAD (ECTBL-2) / Get address of command table. DCA X1 / Save in an index register. TAD T1 / Send the char in the AC. JMS DSPTCH / Dispatch to appropriate routine. If not command / then try inserting character into document. TAD T1 / Get user edit command. SPA CLA / Skip if insertable character. JMP ECBDCM / Report "this command has no meaning here" error. ECINS1, JMS ECDOIN / Check for error & insert character. ECFIX, MOVCHR / Fix up justification. ECFIX3, DCA ECMODE / Reset MODE to ADVANCE. JMP ECLOOP / Go wait for next command. ECBDCM, JMS PUTERR / Output error message. NOMEAN / "this command has no meaning here". JMP ECLOOP / Wait for next command. ECRTN3, ISZ ECOPTN / GOLD:MENU return. IAC / Set Gold:MENU exit flag. ECRTN2, JMS ECEXIT / Do common EDIT/REPLACE exit stuff. JMP I ECOPTN / return to caller. ECHELP, JMS SAVCUR / Save cursor & attributes. AC0001 / set to indicate edit line help JMP HLPKEY / display the help menu ECHPRN, JMS RSTCUR / Restore cursor & attributes. JMP ECLOOP / Get next input. INEDIT, 0 / <> 0 while in ecoptn. ECINIT, XX / Routine common both to EDIT & REPLACE cmnds. JMS DISPLY / Remove reverse video from incorrect word. 0 / ... TAD LINCNT / Get # of lines from start of line w/ error. DCA ELINCT / Initialize our line counter. TAD ELINCT / DCA RLINCT / Initialize distance to restart line. TAD ELINCT / Get distance to edit line. JMS ECSCRL / Scroll Screen down, if appropriate. JMP I ECINIT / Return to caller. ECINI2, XX / Some more edit initialization code. DCA NOMORE / Reset the end-of-line error flag. DCA NOINSR / Reset insert inhibit flag. CDFEDT / Map edit field. TAD SCURPT / Set pointers to point to start of word. DCA I (CURPTR) / text pointer. TAD SCURSR / DCA I (CURSOR) / screen pointer. CDFMYF / back to our field. JMP I ECINI2 / return to caller. ECEXIT, XX / Common exit code for EDIT/REPLACE. DCA T2 / Save GOLD:MENU exit flag. TAD RLINCT / Get distance to restart line. JMS ECSCRL / Scroll Screen to there, if appropriate. JMS ECINI2 / Restore EDT pointers to start of word. MOVCHR / Load "line modified" char if sitting on it. UPDSCN / Update screen (call FXSCRL). DCA LINCNT / Say that we're on bottom line. TAD ELINCT / Compute distance from start of line. CIA / ... TAD RLINCT / .... DCA ELINCT / Save in case this is a GOLD:MENU exit. DCA RLINCT / Reinit for GOLD:MENU re-entry. DCA INEDIT / Say that we're done ECOPTN. TAD T2 / Is this a GOLD:MENU exit? SZA CLA / Skip if no. JMP ECRTN / if yes, then we're done. TAD ELINCT / This is a hard exit back to the main checking SNA CLA / loop. If we're not on the initial line JMP ECRTN / (skip if we're not) then reset sol cursor. TAD SCURSR / ... DCA SLCRSR / .... ECRTN, JMP I ECEXIT / Return to caller. ECPSCN, XX / Routine to call SETCUR. CIFEDT / Call routine in editor field. CALEDT; SETCUR / routine will posn cursor to start of word. CDFEDT / routine DF to editor field. CDFEDT / Map editor field. TAD I (CURSOR) / Set screen posn same as CURSOR. DCA I (CURPOS) / ... CDFMYF / .... JMP I ECPSCN / Return to caller. /------------ PAGE ECHYPS, JMS ECHYPP / Do common hyphen push/pull init. JMP ECHYPY / Label to goto if prior line not hyphenated. AC0001 / Advance to next posn. ECHYPW, MOVCHR / ... CDFEDT / See if line scrolled yet. TAD I (SCRLFL) / ... CDFMYF / .... SZA CLA / Skip if no. JMP ECHYPX / Jmp if yes. Stay where we ended up. CDFEDT / Back to edit field. TAD I (CURSOR) / See if at right margin yet. CIA / ... TAD I (RGTMAR) / .... CDFMYF / Back to our field. SPA SNA CLA / skip if 'not yet'. JMP ECHYPZ / Jmp if yes. ECHYPD, JMS ECGTCH / Get character. JMS CHK040 / See if in alpha range. JMP ECHYPZ / Jmp if no. TAD (2000) / Add in the 'hyphenation' bit. JMS ECPTCH / save char w/ hyphenation bit. ECHYPZ, AC0001 / Advance to next posn until line wraps. GETCHR / ... NOP / Ignore error. JMS CHK040 / See if at end of word. JMP ECHYPX / Jmp if yes. CLA / Start w/ clear AC. CDFEDT / See if line wrapped yet. TAD I (SCRLFL) / ... CDFMYF / .... SNA CLA / Skip if yes. JMP ECHYPZ / Keep advancing until line wraps. ECHYPX, JMS CRSTRT / Re-compute restart point, etc. JMP ECFIX3 / Reset mode to ADVANCE & wait for next input. ECHYPL, JMS ECHYPP / Do common hyphen-push/pull initialization. JMP ECHYPZ / Lable to goto if prior line not hyphenated. AC7777 / Backup to prior character. JMP ECHYPW / ... ECHYPP, XX / Common hyphen-push/pull initialization. JMS TSTLAG / See if we're on the initial line of error. JMP ECBDCM / Cannot Hyphen Push/Pull on 1st line. TAD I ECHYPP / Get transfer instruction. DCA ECHYP1 / Save. ISZ ECHYPP / Bump to real return. CDFEDT / Map EDIT field. Have to do some diddleing. TAD I (LINE23) / Set text ptr to the start of the line. DCA I (CURPTR) / ... DCA I (CURSOR) / Reset screen ptr to start of line. CDFMYF / Back to our field. AC7777 / Backup to last char on previous line. GETCHR / Get the character. JMP ECBDCM / Report error. JMS CHK040 / See if char is in the alpha range. ECHYP1, JMP ECHYPY / Jmp if no. AND (5777) / Clear 'break' bit. JMS ECPTCH / Store char w/o hyphenation bit. ECHYPY, SLNMOD / ... CDFEDT / Map edit field. DCA I (SCRLFL) / Reset 'line scrolled' flag. CDFMYF / Back to our field. JMP I ECHYPP / Return to caller. CHK040, XX / See if character is in alpha range (ie over 40). DCA T1 / Save character. TAD T1 / Get character. AND P177 / isolate onlyy the character bits. TAD (-40) / See if in alpha range. SPA SNA CLA / skip if yes. JMP CKO40 / Jmp to take 'not over' return. TAD T1 / Get character back. ISZ CHK040 / Take 2nd return (char is 'over 40'). CKO40, JMP I CHK040 / Return to caller. / /Dispatch table for Edit commands. / ECTBL, -EDMENU;ECRTN3 / GOLD:MENU -EDNWLN;ECRTN2 / RETURN key -EDHELP;ECHELP / HELP key -EDADVN;ECADVN / ADVANCE key -EDBKUP;ECBKUP / BACKUP key -EDWORD;ECWORD / WORD key -EDBOLD;ECBOLD / BOLD key -EDUBLD;ECUBLD / UNBOLD (gold:bold) key -EDUNDL;ECUNDL / UNDERLINE key -EDUUDL;ECUUDL / UNUNDERLINE (gold:underline) key -EDUPPR;ECUPPR / UPPERCASE key -EDLOWR;ECLOWR / LOWERCASE (gold:uppercase) key -EDSWAP;ECSWAP / SWAP (current & next characters) key -EDRBCH;ECRBCH / RUB CHAR OUT key -EDRBWD;ECRBWD / RUB WORD OUT key -EDDLTC;ECDLTC / DEL CHAR key -EDDLTW;ECDLTW / DEL WORD key -EDUDLT;ECUDLT / UNDELETE (gold:del char or gold:del word) key -EDHYPS;ECHYPS / HYPHEN PUSH key -EDHYPL;ECHYPL / HYPHEN PULL (gold:hyphen push) key 0 / terminator /------------ PAGE ECGETU, XX / Get next character of UNIT routine. CLA / incase we're entered w/ non-zero AC. TAD NOMORE / Are we already at the end of the line? SZA CLA / Skip if no. JMP ECGETE / JMP if yes. Report error. DCA DEADKY / Say "not in DEAD-KEY sequence" (least not yet). LOADCH / Get 1st next character. JMP ECGETE / Sitting on Start/End of file. Return 0000. JMS OVTST / See what type of character current char is. JMP ECGETF / OTHER. see if still on initial line. NOP / NUMERIC. we can always scan. / ALPHA-ONLY. we can always scan. ECGETG, TAD CHAR / Get initial character back. JMS ECHKUN / See if at end of UNIT yet. ECGETX, XX / Co-routine return to test next UNIT char. SMA SZA / Skip if not "at end of UNIT". JMP ECGETY / At end of UNIT (or between UNITs). ECGETQ, SMA CLA / Skip if at start of 2nd UNIT (-1) & return 0. JMS ECGTCH / otherwise return current character. ECGETZ, JMS I ECGETU / Return next character of UNIT to caller. / Return 0 when done returning all characters of / the returned UNIT. SZA / If MODE processor returned a MODEd character JMS ECPTCH / save MODEd character over prior unMODEd char. TAD DEADKY / Are we in the midst of a "dead key sequence"? SZA / Skip if NO. JMP ECGETO / Jmp if yes. Return next character from D-K-S. JMS ECGTCH / Get current character back. TAD (-ECSTOV) / see if it's the start of a DEAD KEY SEQUENCE. SNA CLA / Skip if no. JMP ECGETP / YES. Process next character from D-K-S. ECGETY, CLA / TAD NOMORE / Is the next character the END-OF-LINE char? SZA CLA / Skip if no. JMP ECGETZ / Jmp if yes. report "end-of-unit". AC0001 / Advance to next cursor posn. GETCHR / Get next character. JMP ECGETZ / Return END-OF-UNIT if at end of FILE. JMS OVTST / See what kind of char we have. JMP ECGETH / OTHER. do special end-of-line check. NOP / NUMERIC. treat as ALPHA-ONLY. ECGET2, TAD CHAR / Get character back. JMP I ECGETX / Return & process this character. ECGETP, ISZ DEADKY / Say that we're starting a DEAD KEY SEQUENCE. ECGETO, SPA CLA / Skip if START OF or WITHIN a D-K-S. JMP ECGETR / Handle DONE DEAD KEY SEQUENCE. ADVPTR / Advance to the next character. JMP ECGETZ / Premature termination. TAD (-ECNDOV) / is this the END-OF-DEAD-KEY-SEQ char? SZA CLA / Skip if YES. JMP ECGETQ / JMP if no. return character for processing. AC7777 / Set "end-of-dead-key" flag for next time. DCA DEADKY / That way, we'll get a chance to clean up. JMP ECGETQ / Go process the END-OF-DEAD-KEY-SEQ character. ECGETR, DCA DEADKY / Reset the "IN DEAD-KEY-SEQ" flag. ADVPTR / Advance to the next character. JMP ECGETZ / premature termination. CIFEDT / Backup over the DEAD-KEY sequence. CALEDT; ESBSPC / (BKPSPC) CDFBUF / .... NOP / JMP ECGETY / Now really advance over the Dead Key Seq. ECGETF, JMS CHKEOL / See if char is a line terminator. JMP ECGETE / JMP if yes. Report EOL error. JMS TSTLAG / See if still on line word was found on. JMP ECGETG / YES. go process character. ECGETE, JMS PUTERR / display error message. ERREOL / "end of line reached" error message. JMP ECGETZ / Return to caller. w/ end of UNIT. ECGETH, JMS CHKEOL / See if current char is a line terminator. JMP ECGET2 / If yes, return char (NOMORE is now set). JMS TSTLAG / See is still on same line. SKP / Yes. see if next char is end-of-line char. JMP ECGETZ / Return "end-of-UNIT" if no. ADVPTR / Advance to the next character. JMP ECGETI / next char is end-of-file. TAD (-ECWWLN) / See if next character is WORD-WRAP return. SNA CLA / Skip if no. ISZ NOMORE / If yes, then next time return end-of-unit. ECGETI, BKPPTR / Backup a character posn. NOP / Cann't be at begining of file. CLA / Don't really want returned character. JMP ECGET2 / Return current character. ECGETD, ISZ NOMORE / Set "at-end-of-line" flag. AC7777 / Backup a chacacter. GETCHR / Backup a character. NOP / CLA / don't really want returned character. JMP ECGETZ / Return "end-of-unit" code. DEADKY, 0 / 0 when not in; 1 when in; -1 when exitting. TSTLAG, XX / Routine to see if still on line w/ word on it. CDFEDT / See if any current lag. TAD I (SCRLCT) / ... CDFMYF / also see if any TAD ELINCT / lag from line word is on. SZA CLA / Skip if yes. Take 1st return. ISZ TSTLAG / Not on same line. take "end-of-UNIT" return. JMP I TSTLAG / Return to process end-of-UNIT. CHKEOL, XX / Routine to see if current char is a line terminator. TAD CHAR / Get current character. AND P177 / Isolate just the char bits. TAD (-ECNWLN) / See if it's a LINE TERMINATOR char. SZA CLA / Skip if yes. process it. JMP CKEOL1 / Not line terminator, take 2nd return. ISZ NOMORE / Set NOMORE chars on line flag. SKP / Take 1st return. CKEOL1, ISZ CHKEOL / Not line terminator. Take 2nd return. JMP I CHKEOL / Return to caller. ECPTCH, XX / Routine to save character at posn ptd to by CURPTR. DCA T2 / Save character to save. CDFEDT / Map EDIT field. TAD I (CURPTR) / Get current text pointer. DCA T3 / Save so that we can indirect thru. CDFBUF / Map text field. TAD T2 / Get character to save. DCA I T3 / Save character. CDFMYF / back to our field. JMP I ECPTCH / return to caller. /------------ PAGE ECRBWD, IAC / compute ECUNIT ECRBCH, DCA ECUNIT / Set to 0 for CHARACTER, 1 for WORD. TAD (ECTMRK) / Insert marker into text. INSCHR / ... JMS BACKUP / Backup 1 unit. JMS ECTFBK / Beep & display B-O-L error message. IAC / MODE = DELETE (continue). ECDLTW, IAC / UNIT = WORD. ECDLTC, DCA ECUNIT / UNIT = CHAR. JMS ECDLTU / Go delete the selected unit. JMP ECFIX / Fix line & wait for next command. ECTFBK, XX / To Far BacK. Display error msg. JMS PUTERR / Begining of line reached. ERRBOL / ... JMP I ECTFBK / return to continue deletion. ECLOWR, TAD (40) / Set lower case. ECUPPR, DCA ECMODB / Save CASE bit. IAC / Set CASE. MODE 4. JMP ECMOD3 / Merge below setting of attribute bits. ECUNDL, TAD (400) / Set or ECUUDL, DCA ECMODB / clear UNDERLINE bit(s). ECMOD3, IAC / UNDERLINING. MODE 3. JMP ECMOD2 / Merge below. ECBOLD, TAD (200) / Set or ECUBLD, DCA ECMODB / clear bold bit(s). ECMOD2, IAC / Set/clear attribute bit. MODE 2. ECBKUP, IAC / Set BACKUP. MODE 1. ECADVN, DCA ECMODE / Set ADVANCE. MODE 0. Save mode. SKP / UNIT type is CHARACTER. ECWORD, IAC / UNIT type is WORD. DCA ECUNIT / Save UNIT type. JMS STADVU / Set ADVANCE UNIT transfer vector. TAD ECMODE / Get mode we're processing. TAD (JMP I MODTBL) / Compute JMP to MODE handle. DCA .+1 / save as START OF UNIT handler. JMP I MODTBL / Start processing UNIT via MODE value. STADVU, XX / Routine to set advance UNIT mode. TAD ECUNIT / Compute routine to check UNIT doneness. TAD (JMP I ECUNTB) / ... DCA JMPUNT / save for later transfer to. JMP I STADVU / Return to caller. STBKPU, XX / Routine to set backup UNIT mode. TAD ECUNIT / Get UNIT type. TAD (JMP I ECBUNT) / Make a JMP to start of unit. DCA JMPUNT / Init for start of unit. JMP I STBKPU / return to caller. MODTBL, ECADVU / MODE = ADVANCE ECBAKU / MODE = BACKUP ECBLDU / MODE = BOLD/UNBOLD ECUNDU / MODE = UNDERLINE/UNUNDERLINE. ECUPLO / MODE = UPPERCASE/LOWERCASE CHKRTN, XX / Return from CHECK UNIT. / AC = 0 if scanning UNIT. / AC = 1 when scanning between UNITs (after / scanning unit. / AC =-1 when at start of NEXT UNIT. JMS I ECHKUN / Co Routine return to caller. JMP I CHKRTN / Check this (next) character for UNITization. ECHKUN, XX / Routine called by MODE processor to test / for end of UNIT. JMPUNT, JMP I ECUNTB / Jmp to UNIT processor to test for UNIT doneness. ECUNTB, ECCHRU / UNIT = [advance] CHARACTER ECWRDU / UNIT = [advance] WORD ECCNTU / UNIT = [advance] DELETE (continue) ECBUNT, ECBCHR / UNIT = [backup] CHARACTER ECBWRD / UNIT = [backup] WORD ECUNIT, 0 / UNIT type (0=char; 1=word). ECMODB, 0 / Mode bits to be set in UNIT. /**************************************************************************** / BHOOK Hokk to panel field blaster /a019 /**************************************************************************** SBHOOK, XX / Hook return address /a019 DCA SBLACSV / Save acc. /a019 RDF / Read data field so that it can be /a019 TAD CDF0 / preserved after the call /a019 DCA SBHKEXI / Save the constructed CDF routine /a019 CDFMYF / Make sure I'm here /a019 TAD I SBHOOK / Get the table entry from after the call/a019 MQL / Push into MQ reg /a019 TAD SBLACSV / Get the acc. back /a019 ISZ SBHOOK / Inc return past parameter /a019 CIFMNU / Blaster is in th menu field /a019 IOF / Turn the interups off before.... /a019 JMS I SBLASTH / Calling blaster /a019 ISZ SBHOOK / Skip return exit /a019 SBHKEXI,XX / Place for CDF instruction /a019 JMP I SBHOOK / Return /a019 SBLASTH,BLASTR / Blaster address (in WPF1) /a019 SBLACSV,0 / Acc save area /a019 /**************************************************************************** / TSTCHR Moved to give it room to breathe /a019 /**************************************************************************** /**************************************************************************** / ECSCRL moved here to give DISPLY room to expand /a019 /**************************************************************************** ECSCRL, XX / routine to scroll screen. SNA / Skip if we need to scroll down. JMP I ECSCRL / Return to caller if nothing to scroll. SPA / Skip if to scroll screen down. JMP ECSCUP / JMP to handle scroll up. CIA / Get negative of cursor. DCA T1 / Save negative number of lines to unscroll. ECSCR1, CIFEDT / Call scrolldown to unscroll a line. CALEDT; SCRLDN / ... CDFBUF / Map buffer field. ISZ T1 / 1 more line unscrolled. JMP ECSCR1 / Loop until finished. JMP I ECSCRL / Return to caller. ECSCUP, DCA T1 / Save count of lines to scroll up. ECSCR2, AC0001 / Move to next char posn. GETCHR / ... JMP ECSCR3 / Return if at EOF. CLA / Don't really want char. CDFEDT / See if line changed. TAD I (SCRLCT) / ... CDFMYF / compare to where we want to be. TAD T1 / ... SPA CLA / Skip if we're back to the desired line. JMP ECSCR2 / Loop until we get there. ECSCR3, JMP I ECSCRL / Return when done. /**************************************************************************** / STATR1 Shell for DISPLY set atribute call /a019 /**************************************************************************** STATR1, XX / Location for return address /a019 TAD T2 / Get the new attributes /a019 CIA / See if the same as the previous ones /a019 TAD PRVATR / .... /a019 SZA CLA / Skip if so /a019 JMS SETATR / If not the same, set new ones /a019 JMP I STATR1 / Return /a019 /------------ PAGE ECCHRU, SKP CLA / [advance] CHARACTER UNIT. ECLCHR, / LAST char of UNIT return point. ECBCHR, AC7777 / for [backup] or 2nd [advance] then done. JMS CHKRTN / Return code. JMP ECBCHR / Return done code. /------ ECBWD1, JMS CHKRTN / Return 0 (scanning PRE-WORD UNIT). ECBWRD, JMS TSTCHR / See if character is part of word. JMP ECBWD1 / JMP if no. (non-alphanumeric) Scan more. NOP / NUMERIC -- Part of word. / ALPHA return -- Part of word. ECBWD2, JMS CHKRTN / Return 0 (Scanning WORD UNIT). ECWRDU, JMS TSTCHR / See if character is part of word. JMP ECBWD3 / Jmp if no longer in word. NOP / NUMERIC -- Part of word. Keep scanning. JMP ECBWD2 / ALPHA -- Part of word. Keep scanning. ECBWD3, AC0001 / Return 1. now inbetween WORD unit(s). JMS CHKRTN / ... JMS TSTCHR / See if character is part of word. JMP ECBWD3 / Jmp if NO. continue scanning (non-alpahnumeric). NOP / NUMERIC. YES. Start of NEXT WORD UNIT. JMP ECLCHR / ALPHA. Return start of NEXT WORD UNIT code. /------ ECCNT1, JMS CHKRTN / Return status (0) to caller. ECCNTU, TAD (-ECTMRK) / Are we at our previously inserted mark yet? SZA CLA / Skip if yes. JMP ECCNT1 / Not yet, return "not done yet" code. JMS ECPTCH / ZAP the mark. JMP ECLCHR / Return LAST char of UNIT code. /------------ ECADVU, JMS ECGETU / Check for end of unit. ECADVX, XX / co-routine return point. SZA CLA / zero in AC when at end of UNIT. JMP I ECADVX / Get next character of UNIT. JMP ECLOOP / DONE! go to input loop. /------ ECUPLO, JMS SVSCMD / Save "screen modified" info. JMS ECGETU / Check for end of UNIT. NXUPLO, XX / co-routine return point. SNA / Skip if not at end of unit yet. JMP ECLOOP / DONE! go to edit input loop. JMS CKOV40 / See if character >= 40 (octal). JMP I NXUPLO / No, cannot upper/lower case it. AND (137) / Isolate lower case version. TAD (-133) / See if too big. SMA / Skip if no. JMP CKUPL1 / Yes. cannot case change it. TAD (133-101) / Compare against lower range. SPA CLA / Skip if too small. JMP CKUPL1 / Cannot case change. TAD T1 / Get origional character back. AND (7737) / Isolate without the CASE bit. TAD ECMODB / Add CASE bit if appropriate. JMS ECPTCH / Store case-changed character. JMS CRSTRT / Check for new restart posn. JMP I NXUPLO / Return character & get next. CKUPL1, CLA / Ignore character if not alpha-only. JMP I NXUPLO / ... /------ ECBLDU, JMS SVSCMD / SaVe SCreen MoDified info. JMS ECGETU / Check for end of UNIT. NXBOLD, XX / co-routine return point. SNA / Skip if a character (of current unit) is returned. JMP ECLOOP / DONE UNIT!!! go wait for next edit command. JMS CKOV40 / Is character printable? JMP I NXBOLD / Ignore char if no. AND (7577) / Isolate character minus bold bit. TAD ECMODB / Add BOLD attribute (if appropriate). JMP I NXBOLD / Return character with proper attributes. /------ ECUNDU, JMS SVSCMD / Save "screen modified info". JMS ECGETU / Get next character of UNIT. NXUNDL, XX / co-routine return point. SNA / Skip if not end of UNIT. JMP ECLOOP / DONE UNIT!!! Go process next edit command. JMS CKOV40 / Is character printable? JMP I NXUNDL / Ignore character if no. / allow UNDERLINE but only if / char not SUPERSCRIPTED. RTL / Check the SUPERSCRIPT (1000) bit. SPA CLA / If set, setting UNDERLINE bit yields SUBSCRIPT JMP I NXUNDL / so ignore character if SUPERSCRIPTED. TAD T1 / Get character to add attruibute to. AND (7377) / Isolate w/o UNDERLINE bit. TAD ECMODB / Add attribute bit (if setting). JMP I NXUNDL / Return attributed character. /------ ECBAKU, JMS BACKUP / Back up a UNIT. JMS ECTFBK / display "cannot edit before this line" error msg. JMP ECLOOP / Go get next user input. /------------ SVSCMD, XX / Routine to call SCRNMD editor routine. CIFEDT / ... CALEDT; SCRNMD / This will set appropriate screen modified flags. CDFEDT / Map EDIT field while we're there. JMP I SVSCMD / Return to caller. /----------- / /CHKDEL - Check char about to delete for a line terminator character. / / /CALL: JMS CHKDEL / AC contains 12 bit char to check. / rtn1 /this return if yes. / rtn2 /this return of no. / / This routine sees if the character about to be deleted is in the class / of line terminators (any new-line type and any new-page type). These / chars can only be seen when deleting in a forward direction (ie DELCHR / and DELWRD) and therefore the ECTMRK set for reverse direction deletes / (RUBCHR & RUBWRD) won't be a problem of inadvertantly being left in. / /----------- CHKDEL, XX / Entry point. TAD (-ECWWLN) / Check for soft terminators. SZA / Skip if yes. TAD (ECWWLN-ECHYLN) / another soft line terminator. SZA / Skip if yes. TAD (ECHYLN-ECPMRK) / Soft page (PAGE MARKER)? SNA / Skip if no. JMP CHKDL1 / let these pass, they're not word terminators. TAD (ECPMRK) / Restore origional char. AND P177 / Isolate only the character bits. TAD (-ECNWLN) / See if in the line class of terminators. SZA / Skip if yes. TAD (ECNWLN-ECNWPG) / if not see if in the page class of terminators. SZA CLA / Skip if yes. take the 1st return. CHKDL1, ISZ CHKDEL / Not a line terminator. Take the 2nd return. JMP I CHKDEL / Return to caller. /------------ PAGE BACKUP, XX / Backup a UNIT. CIFEDT / 1st save current LINE MODIFIED FLAG. CALEDT; SAVLMD / ... CDFBUF / .... JMS TSTLAG / see if on initial line word is on. SKP / Skip if yes. JMP BCKUPA / No. All backup is allowed. TAD SLCRSR / Get cursor address of 1st word on line. CIA / Compare to where we currently are. CDFEDT / ... TAD I (CURSOR) / ... CDFMYF / .... SPA SNA CLA / Skip if not at start of 1st word on line. JMP BCKUPY / Return to caller to report error. BCKUPA, AC7777 / Do a CURMOV of -1. GETCHR / Get previous character. JMP BCKUPV / Already sitting on STX. Go fix. CLA / Don't really want character. ISZ BACKUP / Bump return for when we finally take it. JMS STBKPU / Set Backup UNIT routine. DCA NOMORE / reset forward e-o-l indicator. DCA NOINSR / insert's are now allowed. JMS ECGTCH / Get current character. JMS ECHKUN / Start checking the UNIT. BCKUPZ, XX / co-routine return goes here. SZA / Skip if in unit. JMP BCKUPX / Jmp if might not in unit. AC7777 / Backup to next character posn. GETCHR / Backup to previous posn. JMP BCKUPV / JMP if at start of text buffer. JMP I BCKUPZ / return character to UNIT processor. BCKUPX, SPA CLA / Skip if just went beyound unit. must now advance. BCKUPY, JMP I BACKUP / When at start of next unit we're done. RETURN. AC0001 / do an advance. GETCHR / load next character. JMP BCKUPY / Return if at end of text. JMP I BCKUPZ / Go process this character. BCKUPV, GETCHR / Fix up CURSOR. NOP / Just return. CLA / clear character just returned. JMP BCKUPY / .... /------------- / /RCOPTN - handle REPLACE option for SPELLING CORRECTOR. / / This routine replaces the highlighted error word with the selected / word from the replacement list. This routine essentially does a RUB WRD / function to DELETE the error word & then does an INSERT WORD to insert / the selected word. This routine is called with the AC pointing to the / replacement word (which will always be terminated by a SPACE). Inputs / to this routine are the same as those to the EDIT routine. Infact, / common INIT and EXIT code has been placed into subroutines which both / the EDIT command & this REPLACE command use. / / /CALL: JMS RCOPTN (from USER MENU dispatcher). AC points to replacement word. / rtn Return here when done. / /-------------- RCOPTN, XX / Entry point. DCA RCTEMP / Save ptr to replacement text string. ADVPTR / Bump to after last character. NOP / Ignore possible E-O-F. CLA / Clear return code from ADVPTR. TAD (ECTMRK) / Insert stopper for DELETE routine. INSCHR / ... JMS ECINIT / Call common initialization code. JMS ECINI2 / Do rest of edit initialization. AC0002 / Set mode to DELETE mode. DCA ECUNIT / ... JMS ECDLTU / Delete the selected word. AC7777 / Get ptr minus 1 to text of replacement string. TAD RCTEMP / ... DCA X5 / Save ptr to text in an index register. RCOPT1, TAD I X5 / Get next char. TAD (-ECSPC) / Check for done. SNA / Skip if not done. JMP RCOPT2 / JMP when done insert. TAD (ECSPC) / Get original char back. /d019 TAD DISATR / Add in attributes. DCA T1 / Save char for DOINSR. JMS ECDOIN / insert character. JMP RCOPT1 / Loop for all replacement word chars. RCOPT2, MOVCHR / Rejustify word. CDFEDT / Get scroll count (if any). TAD I (SCRLCT) / ... CDFMYF / Back to our field. DCA T1 / save. TAD T1 / Get lag count. TAD ELINCT / Keep track which line we are on. DCA ELINCT / ... TAD T1 / Get lag count. TAD RLINCT / update distance to restart line. DCA RLINCT / ... JMS ECEXIT / Do common cleanup code. (Must call w/ AC=0). JMP I RCOPTN / Take RETURN return. RCTEMP, 0 / Temp to hold ptr to replacement text. SETATR, XX / routine to set attributes from T2. TAD T2 / Get attributes to set. DCA PRVATR / Save them for ourselves. TAD T2 / Now set them for BLKBOX. CIFPRT / ... JMS I (BLKBOX) / now the screen has proper attributes set. TAD VIDEO / reverse? SZA CLA / Skip if no. JMS SETRV / When yes, add reverse video too! JMP I SETATR / return to caller. UNDOLG, XX / Routine to call FXSCRL. TAD LINCNT / Update # of lines in word. DCA LINCNT / ... ISZ NEWLIN / Say that a NEW LINE has been seen!!! UPDSCN / Update Screen (FXSCRL). JMP I UNDOLG / Return to caller. CKOV40, XX / Routine to see if character passed is > 40. DCA T1 / Save origional character. TAD T1 / Get character back. AND P177 / Isolate character bits. TAD (-ECTAB) / Is character a TAB character? SZA / Skip if yes. Return as if it's a char. TAD (ECTAB-40) / See if >= 40. SPA CLA / Skip if yes. JMP I CKOV40 / Return if no. take SPECIAL char return. TAD T1 / otherwise return character in AC. ISZ CKOV40 / and take the skip return. JMP I CKOV40 /------------ PAGE /---------- / /ECDLTU - Delete a UNIT. / / / This routine deletes a UNIT. For RUB functions, an ECTMRK was inserted / at the current posn, a backup UNIT (char/word) function was performed, / and the MODE was set to CNTMOD (scan terminated by the ECTMRK). For a / DEL function, the MODE was set to ADVANCE, and we delete characters / until we come to the end of the UNIT (char/word). / /---------- ECDLTU, XX / Entry point. JMS STADVU / Set ADVANCE UNIT transfer vector. TAD (BASKET-1) / Get address of UNDELETED thing buffer. DCA X5 / Save in an index register. DCA UNDLCT / Init count of characters to none. CDFEDT / TAD I (CURPTR) / Get ptr to start of thing to delete. CDFMYF / Back to our field. DCA ECDPNT / Save pointer. GETCHR / Load current character. JMP ECDLTZ / Quit if at End-Of-File. JMS CHKDEL / See if line terminator. JMP ECDEOL / JMP if yes. Display error & quit. DCA NOMORE / reset forward e-o-l indicator. DCA NOINSR / insert's are now allowed. JMS ECGTCH / Go get char back. JMS ECHKUN / Test char for end-of-UNIT. ECDLTN, XX / Co-routine return point saved here. SPA CLA / Skip if not at end of unit yet. JMP ECDLTX / Quit when done. JMS ECGTCH / Get character. JMS CHKDEL / See if line terminator. JMP ECDLTX / If yes, terminate delete operation & sit on it. JMS ECGTCH / Get character again. /d019 ECDLTP, JMS ECDPUT / Put char into the UNDELETE buffer. /d019 ECDLTA, JMS ECPTCH / Zap char with a null. /d019 ECDLTE, ADVPTR / Advance (& expand text buffer) to next char. /d019 JMP ECDLTX / Jmp if End-Of-File. TAD (-ECSLPT) / Select point? (shouldn't unless from prior edit). SNA / Skip if no. JMP ECDLTS / Go handle SELECT POINT. TAD (ECSLPT-ECRMFL) / RULER Modified? SNA / Skip if no. JMP ECDLTM / YES, go handle RULER MODIFIED code. TAD (ECRMFL-ECSTRL) / Start of RULER? SNA / Skip if no. JMP ECDLTR / Go handle RULER. TAD (ECSTRL-ECSTOV) / Start of DEAD-KEY Sequence? SNA CLA / Skip if no. JMP ECDLTO / Go handle OVERSTRIKE (DEAD-KEY Sequence). JMS ECGTCH / Get character back. CIFEDT / See if something "soft". CALEDT; ESJCHK / ... CDFEDT / .... SNA CLA / Skip if not "soft". JMP ECDLTA / Zap the "softie" & advance to next char posn. ECDLTP, JMS ECDPUT / Put char into the UNDELETE buffer. /m019 ECDLTA, JMS ECPTCH / Zap char with a null. /m019 ECDLTE, ADVPTR / Advance (& expand text buffer) to next char./m019 JMP ECDLTX / Jmp if End-Of-File. /m019 /d019 JMS ECGTCH / Get character back. JMP I ECDLTN / Go check this character. ECDLTX, TAD (ECMDFL) / Set "line modified" flag. INSCHR / so that if we crossed a ruler, all will justify. JMS ECDSET / Reset CURPTR back to start of stuff to delete. SLNMOD / Set "line modified" flag. CDFEDT / Get line modified flag. TAD I (LINMOD) / ... CDFMYF / INSCHR / and insert it into text. JMS ECDSET / Reset CURPTR back to start of stuff to delete. SLNMOD / Set "line modified" flag. JMS CRSTRT / Fix restart CURPTR/CURSOR. ECDLTZ, JMP I ECDLTU / Return to caller. ECDEOL, JMS PUTERR / Display "end-of-line" error message. ERREOL / ... JMP ECDLTZ / and then quit. ECDLTM, JMS ECGTCH / Get current character. CDFEDT / Map edit field so that DCA I (RLRMOD) / we can save the ruler modified flag. CDFMYF / Back to our field. ECDLTS, JMP ECDLTA / Delete char from file & continue. ECDLTO, JMS ECDPUT / Output char to UNDELETE buffer. JMS ECPTCH / ZAP char. eliminate from text buffer. ADVPTR / Advance to the next character. JMP ECDLTX / exit if at end of file. TAD (-ECNDOV) / End of OVERSTRIKE (DEAD-KEY Sequence)? SZA CLA / Skip if YES. JMP ECDLTO / Loop if no. Go do next character. JMP ECDLTP / otherwise output & try advance. ECDLTR, ADVPTR / Get next character SKP / treat E-O-F like End-Of-Ruler (AC is 0). TAD (-ECNDRL) / End of ruler? SZA CLA / Skip if yes. JMP ECDLTR / JMP if no. continue to scan until find end. JMP ECDLTE / Done processing ruler. Continue delete on next char. ECDPUT, XX / Routine to output current char to DELETE buff. TAD UNDLCT / See if basket is full yet. TAD (-BASKSZ) / Compare to max. SNA CLA / Skip if not yes. JMP I ECDPUT / Return w/o saving char if DELETE area full. JMS ECGTCH / Get character. CDFBUF / Save in waste-basket. DCA I X5 / ... CDFMYF / Back to our field. ISZ UNDLCT / 1 more char in basket. JMP I ECDPUT / Return to caller. ECDSET, XX / Routine to reset CURPTR back ECDPNT. CDFEDT / Reset CURPTR. TAD ECDPNT / set it to start of stuff to delete. DCA I (CURPTR) / ... CDFMYF / .... JMP I ECDSET / Return to caller. ECDPNT, 0 / CURPTR of start of deleted text. ECGTCH, XX / Routine to get character pointer to by CURPTR. / Assumed that entered with AC=0. CDFEDT / Map EDIT field. TAD I (CURPTR) / Get character pointer. DCA T3 / Save pointer. CDFBUF / Map TEXT field. TAD I T3 / Get character. CDFMYF / finally, return to caller. JMP I ECGTCH / ... /------------ PAGE ECSWAP, TAD NOINSR / Are we beyond the INSERT boundry? SZA CLA / Skip if no. We can still SWAP. JMP ECSWPB / Report at End-Of-Line. JMS ECSWPA / Check char we're sitting on for valid SWAP char. AC0001 / Move to next char posn. GETCHR / Get to next character. JMP INSERR / Report "at end of line" error. DCA T1 / Save 2nd char (incase we SWAP). JMS ECSWPA / See if this (2nd) char is swapable. JMS ECPTCH / Zap 2nd character. SLNMOD / Set line modified flag. AC7777 / Backup to prior (1st) char posn. GETCHR / Backup to previous character. JMP INSERR / Shouldn't get here but handle error. CLA / not interested in returned char. JMP ECINS1 / Go insert 2nd char infront of 1st char. ECSWPA, XX / Routine to check char for valid SWAP char. LOADCH / 1st, load char we're sitting on. JMP ECSWPB / If error beep & give up. AND P177 / Isolate char only. TAD (-ECNWLN) / LINE TERMINATOR is invalid SWAP char. SZA / Skip if not valid. TAD (ECNWLN-ECNWPG) / PAGE TERMINATOR is invalid SWAP char. SZA / Skip if not valid. TAD (ECNWPG-ECSTOV) / Start of DEAD-KEY is invalid SWAP char. SZA CLA / Skip if not valid SWAP char. JMP I ECSWPA / Return if char is swapable. ECSWPB, JMS PUTERR / Display "invalid SWAP" error message. ERRSWP / ... JMP ECLOOP / go wait for another input. /---------- / /ECUDLT - Undelete a UNIT. / / / This routine the last deleted text of this edit. The text was saved / in the 'waste-basket' (buffer field, @ basket), the length of the / last deleted item is stored in UNDLCT. A zero there means that the / waste basket is empty. / /---------- ECUDLT, TAD UNDLCT / Get size of UNDELETE buffer. SNA / Skip if there's something in it. JMP ECFIX3 / Reset MODE to advance & get next command. CIA / compute ISZ count. DCA T2 / Save character count. TAD (BASKET-1) / Get ptr to UNDELETE buffer. DCA X5 / save in index register. ECUDLP, CDFBUF / Map TEXT field. TAD I X5 / Get char to UNDELETE. CDFMYF / Back to our field. DCA T1 / Save character for later check. JMS ECDOIN / insert character. ISZ T2 / loop while still more to insert. JMP ECUDLP / Loop to undelete next character. JMP ECFIX / Fix mode & get next input. ECD8IN, XX / Routine to check for allowable insert & do it. TAD NOINSR / Check for End-Of-Line encountered. SZA CLA / Skip if not at End-Of-Line yet. JMP INSERR / Report insert error (e-o-l reached). TAD T3 / Get character to insert. /m019 INSCHR / Insert char into document. SLNMOD / Set "modified" flag. TAD T3 / Get character back. /m019 TAD (-ECSTOV) / Start of "Dead Key Sequence"? SNA / Skip if no. JMP DOINS1 / Go handle start of DEAD-KEY-SEQUENCE. TAD (ECSTOV-ECNDOV) / End of "Dead Key Sequence"? SNA CLA / Skip if no. JMP DOINS2 / Jmp to process End of DEAD-KEY-SEQUENCE. TAD INSDKS / Are we currently in a DEAD-KEY sequence? SNA CLA / Skip if YES. JMP DOINS4 / No. go handle regular insert. BKPPTR / continue overstrike mode. See if prior char NOP / is END-OF-DEAD-KEY. TAD (-ECNDOV) / Check prior char for end-of-deadkey. SZA CLA / Skip if yes. insert char there instead. JMP DOINS3 / No. cancel dead-key seq. JMS ECPTCH / Cancel prior end-of-deadkey. ADVPTR / Advance to char just inserted. NOP / ... DOINS1, ADVPTR / Advance just beyond char just inserted. NOP / ... CLA TAD (ECNDOV) / Insert End-Of-Deadkey sequence char. INSCHR / ... ADVPTR / Advance beyond end-of-deadkey char just inserted. NOP / ... AC0001 / Say that we're in a dead-key sequence. JMP DOINS5 / done. DOINS2, JMS ECPTCH / Cancel redundant end-of-deadkey. CDFEDT / Bump cursor posn to next col. ISZ I (CURSOR) / ... CDFMYF / .... JMP DOINS5 / done. DOINS3, ADVPTR / Bump past char just inserted. NOP / ... CLA DOINS4, CIFEDT / Do rejustification (if necessary). CALEDT; CHKREJ / Call CHKREJ to see if rejustification CDFBUF / is appropriate. DOINS5, DCA INSDKS / Cancel/Set overstrike mode. AC7777 / Check restart CURSOR/CURPTR for insert. JMS CRSTRT / Check restart CURSOR/CURPTR. TAD T3 / Get prior char (ie. the one just inserted.)/m019 JMS TSTCHR / Check it's type. JMP DOINS6 / OTHER. See if we were at End-Of-Line. JMP DOINS7 / NUMERIC & JMP DOINS7 / ALPHA-ONLY are always insertable. DOINS6, JMS TSTLAG / See if on same line as word was on. JMP DOINS7 / YES. char does not define new E-O-L. ISZ NOMORE / We just inserted a new E-O-L definition. ISZ NOINSR / so stop further ADVANCE & INSERT. DOINS7, CDITXT / Back to field that called it /a019 JMP I ECD8IN / Return to caller. Char is inserted & flags set. INSDKS, .-. INSERR, JMS PUTERR / Display error. ERREOL / "End of line reached" error message. JMP ECFIX3 / Reset MODE to ADVANCE & get next input. /----------- PAGE /----------- / /CRSTRT - Check restart CURSOR & CURPTR / / /CALL: JMS CRSTRT /AC=0/-1 upon entry & 0 upon exit. / / If insert, then AC=-1 so we know to backup. / / / This routine checks to see if we're still on the 1st edit line. / If not, then an immediate return is made & we are done. Otherwise / there are 2 cases to consider. / / Case 1) We are before or on the prior restart point. In this case, / CURSOR will be <= SCURSR before rejustification. In this / case, the word we are on is by definition the word to backup / to. So, we rejustify the line, save our new (rejustified) posn, / backup a character if from INSERT, backup while not in OTHER, / advance until in NUMERIC or ALPHA & save that posn as the / restart point. We go back to our saved (rejustified) posn & are / finished. / / Case 2) We are after the prior restart point. In this case, / CURSOR will be > SCURSR before rejustification. We need to / compute the proper SCURSR/SCURPT after rejustification. To / accomplish this, we scan backwards counting the number of posns / we pass until we get to the restart point. We remember this / count, go back to our initial point, rejustify, scan backwards / the remembered count & save that CURSOR/CURPTR as the restart / SCURSR/SCURPT. We return to the new (rejustified) initial point / and are finished. / /----------- CRSTRT, XX / Entry point. DCA RSTMT3 / Save insert indicator. JMS TSTLAG / Are we on the initial edit line? SKP / Skip if yes. we got's lots to do. JMP I CRSTRT / No. just return. TAD SLCRSR / Compute distance to start of line. JMS GETDST / ... DCA SLDIST / Save the distance. CDFEDT / See if the restart line is initial line. TAD I (SCRLCT) / ... CDFMYF / .... TAD RLINCT / Is the restart line same line? SZA CLA / Skip if yes. JMP RCASE1 / JMP if no. we're definately case 1. CDFEDT / Map edit field. TAD I (CURSOR) / Get current screen posn. CDFMYF / CIA / compare screen posn to start of restart word. TAD SCURSR / ... SPA CLA / Skip if case 1. (ie we're on or before restart). JMP RCASE2 / Jump to handle case 2. RCASE1, MOVCHR / Rejustify. DCA RSDIST / Init distance back to 0. TAD RSTMT3 / Get "in INSERT" flag. SNA / Skip if not 0. gotta move to char just inserted. JMP CRSTL1 / Merge below. MOVCHR / Backup if in insert. this will posn us to / the char just inserted. AC7777 / start out our backup count for the 1st char. DCA RSDIST / ... CRSTL1, AC7777 / Make a note that 1 more char scanned. TAD RSDIST / ... DCA RSDIST / .... AC7777 / Backup until out of word. GETCHR / ... JMP CRSTL3 / if hit start of file, quit. JMS TSTCHR / Check character type. JMP CRSTL2 / OTHER, quit. JMP CRSTL1 / NUMERIC. continue to backup. JMP CRSTL1 / ALPHA. continue to backup. CRSTL2, AC0001 / Now advance to start of word. CRSTL3, MOVCHR / Move CURSOR. ISZ RSDIST / Make a note that 1 less char got scanned. LOADCH / Skip if not at starting point yet. JMP CRSTL4 / If at starting point, then quit. JMS TSTCHR / Check character type. JMP CRSTL2 / OTHER. continue scanning. JMP CRSTL4 / NUMERIC. done. CRSTL4, CDFEDT / Map edit field. TAD I (CURSOR) / Get CURSOR DCA SCURSR / Save as restart CURSOR. TAD I (CURPTR) / Get CURPTR. DCA SCURPT / Save as restart CURPTR. TAD I (SCRLCT) / compute distance to the restart line. CIA / .... DCA RLINCT / save for future reference. CDFMYF / Back to our field. TAD RSDIST / We're currently at the restart point. Compute CIA / the distance to the start-of-line point TAD SLDIST / ie dist from restart minus dist from sol. MOVCHR / Go to start of the line. CDFEDT / Get CURSOR posn. TAD I (CURSOR) / ... CDFMYF / and save it as the new DCA SLCRSR / start of line cursor posn... TAD SLDIST / Get distance back to our posn. CIA / ... MOVCHR / go back to our posn. TAD SLDIST / Are we at the start of the line? SZA CLA / Skip if yes. JMP CRSTL5 / JMP if no. Leave ELINCT as is. TAD RLINCT / Reset ELINCT to allow for deleting DCA ELINCT / across a ruler. CRSTL5, JMP I CRSTRT / Return to caller. RCASE2, TAD SCURSR / Compute distance to restart point. JMS GETDST / ... DCA RSDIST / Save count to restart point. MOVCHR / Rejustify the line. TAD RSDIST / Get # of posns to back to to restart point. MOVCHR / backup to that posn. JMP CRSTL4 / Save this posn as the restart posn, restore / to rejustified posn & we're done. CRSTMV, XX / Routine to do a CURMOV only. GETCHR / Get & LOAD char. NOP / Error will be handled later. CLA / Don't return the char. JMP I CRSTMV / Return w/ clean AC. GETDST, XX / Routine to compute distance from current posn / to posn passed in the AC. Return is negative. DCA RSTMT1 / Save posn to backup to. CDFEDT / Save current CURSOR & CURPTR. TAD I (CURSOR) / ... DCA SAVT1 / ... TAD I (CURPTR) / ... DCA SAVT2 / .... CDFMYF / Back to our field. DCA RSTMT2 / Init count. GTDST1, CDFEDT / Map edit field. TAD I (CURSOR) / Get CURSOR. CDFMYF / Back to our field. CIA / Compare CURSOR to restart posn (SCURSR). TAD RSTMT1 / ... SNA CLA / Skip if not there yet. JMP GTDST2 / Jmp when we arrive to start of restart word. AC7777 / Backup that posn. GETCHR / ... JMP GTDST2 / If error, quit. CLA / Don't really want char. ISZ RSTMT2 / 1 more char posn bumped over. JMP GTDST1 / Go see if done yet. GTDST2, CDFEDT / Now, restore us to where we were. TAD SAVT1 / This way we won't rejustify (yet). DCA I (CURSOR) / Also, since rejustification hasn't been TAD SAVT2 / done yet, we know that we're still on DCA I (CURPTR) / the same line. CDFMYF / Back to our field. TAD RSTMT2 / Get count. CIA / Return negative count. JMP I GETDST / ... SAVT1, 0 / Temp for saved CURSOR. SAVT2, 0 / Temp for saved CURPTR. RSTMT1, 0 / restart point to scan to. RSTMT2, 0 / Distance to restart point. RSTMT3, 0 / A temp. RSDIST, 0 / Distance to restart point. SLDIST, 0 / Distance to start of line. /------------ PAGE /----------- / /SLNMOD / / /----------- ECSLMD, XX / Routine to x-field call SETLMD (SLNMOD). CIFEDT / Call SETLMD to set screen update flags. CALEDT; SETLMD / ... CDFEDT / .... JMP I ECSLMD / Return to caller. /----------- / /ADVPTR / / /----------- ECAPTR, XX / Routine to call ESAPTR in edit field. CIFEDT / Move CURPTR to next character. CALEDT; ESAPTR / ADVPTR routine. CDFBUF / field to be mapped to. SKP / 1st return, take same return to caller. ISZ ECAPTR / Bump to correct return. JMP I ECAPTR / ... /----------- / /BKPPTR / / /----------- ECBPTR, XX / Routine to call ESBPTR in edit field. CIFEDT / Backup to where we were. CALEDT; ESBPTR / BKPPTR CDFBUF / .... SKP / Take 1st return. ISZ ECBPTR / Take 2nd return. JMP I ECBPTR / Return to caller. /----------- / /INSCHR / / /----------- ECICHR, XX / Routine to call INSERT in edit field. CIFEDT / CALEDT; INSERT / Call INSERT CDFBUF JMP I ECICHR / Return to caller. /----------- / /GETCHR / / /----------- ECGCHR, XX / Routine to call CURMOV & LODCHR. CIFEDT / Call editor routine to insert character. JMS I (GETCH) / Call routine in editor field. SKP / Return via 1st return. ISZ ECGCHR / Return via 2nd return. JMP I ECGCHR / Return to caller. /----------- / /LOADCH / / /----------- ECLOAD, XX / Routine to call LODCHR. CIFEDT / Call editor routine to load character. CALEDT; LODCHR / ... CDFBUF / buffer field to be BUFFLD. SKP / Take 1st return. ISZ ECLOAD / Take 2nd return. JMP I ECLOAD / Return to caller. /----------- / /UPDSCN / / /----------- FXSCRN, XX / Routine to call FXSCRL in edit field. CIFEDT / CALEDT; FXSCRL / Call FXSCRL CDFEDT / .... JMP I FXSCRN / Return to caller. /----------- / /CHKSCN / / /----------- CKSCRN, XX / Routine to call TSTLIM & then FXSCRL. CIFEDT / CALEDT; TSTLIM / Call TSTLIM CDFEDT / .... UPDSCN / Call FXSCRL to repaint. JMP I CKSCRN / Return to caller. /----------- / /PUTERR - display error message on bottom line. / / /CALL: JMS PUTERR / display error message on bottom line. / ptr / pointer to a TEXT string for IOA. / /----------- PUTERR, XX / entry point. JMS SETMOD / set modes, ring bell, etc... TAD I PUTERR / Get error msg text pointer. TAD (-BLANKL) / Is this the call to clear the error msg? SNA CLA / Skip if no. Ring the bell. JMP PUTER1 / Don't ring the bell if clearing the line. PUTCHR; BELL / Ring the bell. PUTER1, TAD I PUTERR / Get address of text string to display. ISZ PUTERR / Bump to return address. DCA PUTER2 / Save it for IOACAL. CIFTXT / Call output IOA output routine in TXT field. JMS I (CALIOA) / display the message PUTER2, .-. / arg1 -2700 / arg2 NOP / arg3 JMS RSTCUR / restore cursor and attributes. ISZ ECERFL / Say that there is an error msg being displayed. JMP I PUTERR / return to caller. /---------- / / /---------- SETMOD, XX JMS SAVCUR / save cursor posn and attributes. JMS SETABS / Set ORIGIN mode to ABSOLUTE mode. JMS CLRRV / Eliminate any current attributes. JMS SETRV / Error message gets output in reverse video. JMP I SETMOD TYMOUT, TAD (TIMERR-FATAL) / offset to error msg GTOOPS, BADBLO, DSKERR, TAD (FATAL) / pointer to text message DCA DYSKE1 / set up for display CDFMNU / Get the option word. TAD I (MUBUF+MNPULD) / Get the external processor loaded word./M004 AND (-1-MNRX0X-MNRX1X) / clear the American & British loaded bits./M004 DCA I (MUBUF+MNPULD) / Save new external processor loaded word./M004 CDFMYF / Back to our field. DYSKER, JMS PUTERR / Ring bell & display error msg. DYSKE1, .-. / arg1 JMS IPTCHR / Get an input character. TAD (-EDNWLN) / Return typed? SZA CLA / skip if yes. JMP DYSKER / Repeat message if not RETURN key. JMP EOF / Time to shut down!!! /---------- / / DSPTCH - routine to dispatch control / / / CALL: JMS DSPTCH / rtn1 / only return if: end of table encountered / / Inputs: / X1 - pointer to the dispatch table / T1 - character being matched to the dispatch table / (passed here in the AC) / / Outputs: / Control is passed to the appropriate routine, unless / a match is not made, in which case, return to caller / /---------- DSPTCH, XX / Return address DCA T1 / save the input char to check DSPTC1, ISZ X1 / bump rest of this entry. TAD I X1 / Check next table entry. SNA / Skip if there is one. JMP I DSPTCH / no more valid commands, return to process. TAD T1 / see if table entry matches desired command. SZA CLA / Skip if yes. JMP DSPTC1 / Check entry. TAD I X1 / Get address of routine to call. DCA T1 / Save for jump indirect thru. JMP I T1 / Dispatch to edit routine. / / here if user dictionary fills up during initialization / USDFUL, TAD (UDFUL2) / error message. DCA DYSKE1 / ... JMP DYSKER / Display error message, wait for return & abort. /---------- PAGE PTCHRS, XX / Routine to output a string of chars. PUTCH1, TAD I PTCHRS / Get next character to output. AND P177 / Isolate only the character bits. JMS OPTCHR / Output character. TAD I PTCHRS / Get character just output. ISZ PTCHRS / Bump to next char/return address. SPA CLA / Skip if last one was the last. JMP PUTCH1 / Go do next character. JMP I PTCHRS / Done! return to caller. / / / OPTCHR, XX / return address JMP OPTCH2 OPTCH1, CIFSYS JWAIT OPTCH2, CIFSYS TTYOU / output the char JMP OPTCH1 JMP I OPTCHR / return when done POSNCU, XX / Routine to init EDT pointers to start of / word & posn screen CURSOR. TAD SCURPT / Reinit text pointer. CDFEDT / CURPTR is in EDT field. DCA I (CURPTR) / ... TAD SCURSR / Reset cursor column address variable. DCA I (CURSOR) / .. TAD LINCNT / Reset cursor line address variable. CIA / DCA I (CURLIN) / "Current line number". CDFMYF / ... JMS ECPSCN / Call SETCUR to posn the cursor. JMP I POSNCU / return to caller. /----------- / / GRAFXS - set graphics mode / / / CALL: JMS GRAFXS AC ignored & destroyed on return / / ESC ( 0 / /----------- GRAFXS, XX / return address PUTCHR; 4000+ESC / output escape sequence to the terminal 4000+"( / "0&177 / JMP I GRAFXS / return to caller /----------- / / GRAFXC - clear graphics mode / / / CALL: JMS GRAFXC AC ignored & destroyed on return. / / ESC ( B / /----------- GRAFXC, XX / return address PUTCHR; 4000+ESC / output escape sequence to the terminal 4000+"( / "B&177 / JMP I GRAFXC / return to caller /----------- / /SETRGN - Set scrolling region up. / / /CALL: JMS SETRGN AC ignored & destroyed on return. / / ESC [ 3 ; 11 r / /----------- SETRGN, XX / entry point. PUTCHR; 4000+ESC / define scrolling region from line 3 to 13 4000+"[ / Send escape sequence to terminal to 4000+"3 / From line 3, 4000+"; / ... 4000+"1 / to line 4000+"1 / 11 "r&177 / terminator. JMS SETREL / Set ORIGIN mode to RELATIVE (relative to region). JMP I SETRGN / Return to caller. /----------- / / STMRGN - Set scrolling region for help menus. / / / CALL: JMS STMRGN AC ignored & destroyed on return. / / ESC [ 16 ; 24 r / /----------- STMRGN, XX / return address PUTCHR; 4000+ESC / output the escape sequence to the terminal 4000+"[ / define scrolling region 4000+"1 / from line 14, 4000+"4 / ... 4000+"; / to line 4000+"2 / 24 4000+"4 / ... "r&177 / JMP I STMRGN / return to caller /----------- / /CLRRGN - Clear scrolling region upon exit. / / /CALL: JMS CLRRGN AC ignored & destroyed on return. / / ESC [ r / /----------- CLRRGN, XX / entry point. PUTCHR; 4000+ESC / Send escape sequence to terminal to 4000+"[ / undefine scrolling region. "r&177 / terminator. JMS SETABS / Set ORIGIN mode to absolute. JMP I CLRRGN / Return to caller. /----------- / /SETREL - Set ORIGIN mode to relative. / / /CALL: JMS SETREL AC ignored & destroyed on return. / / ESC [ ? 6 h / /----------- SETREL, XX / Entry point. PUTCHR; 4000+ESC / Send escape sequence to terminal. 4000+"[ / ... 4000+"? / ... 4000+"6 / ORIGIN mode "h&177 / relative. JMP I SETREL / Return to caller. /----------- / /SETABS - Set ORIGIN mode to absolute. / / /CALL: JMS SETABS AC ignored & destroyed on return. / / ESC [ ? 6 l / /----------- SETABS, XX / Entry point. PUTCHR; 4000+ESC / Send escape sequence to terminal. 4000+"[ / ... 4000+"? / ... 4000+"6 / ORIGIN mode "l&177 / absolute. JMP I SETABS / Return to caller. /----------- / /SAVCUR - Save cursor and attributes. / /CALL: JMS SAVCUR AC ignored and destoryed on return. / / ESC 7 / /----------- SAVCUR, XX / entry point. PUTCHR; 4000+ESC / Output escape sequence to save cursor & attr. "7&177 / ... JMP I SAVCUR /----------- / /RSTCUR - Restore cursor and attributes. / /CALL: JMS RSTCUR AC ignored and destoryed on return. / / ESC 8 / /----------- RSTCUR, XX / entry point. PUTCHR; 4000+ESC / Output escape sequence to restore cursor & attr. "8&177 / ... JMP I RSTCUR /----------- / / SETRV - Set screen to reverse video mode. / / / CALL: JMS SETRV AC is 0 on entry & return. / / ESC [ 7 m / /----------- SETRV, XX PUTCHR; 4000+ESC / Output escape sequence to set terminal attributes. 4000+"[ / 4000+"7 / "m&177 / JMP I SETRV / Return to caller. /----------- / / CLRRV - Reset screen of all attributes. / / / CALL: JMS CLRRV AC is 0 on entry & return. / / ESC [ 0 m / /----------- CLRRV, XX PUTCHR; 4000+ESC / Output escape sequence to set terminal attributes. 4000+"[ / 4000+"0 / "m&177 / JMP I CLRRV / Return to caller. /----------- / / STBOLD - set bold / / / CALL: JMS STBOLD AC ignored & destroyed on return. / / ESC [ 1 m / /----------- STBOLD, XX / return address PUTCHR; 4000+ESC / output escape sequence to the terminal 4000+"[ / 4000+"1 / "m&177 / JMP I STBOLD / return to caller /----------- / / STUNDR - set underline mode / / / CALL: JMS STUNDR AC ignored & destroyed on return. / / ESC [ 4 m / /----------- STUNDR, XX / return address PUTCHR; 4000+ESC / output escape sequence to the terminal 4000+"[ / 4000+"4 / "m&177 / JMP I STUNDR / return to caller /------ PAGE /---------- / / SNDWRD - Sends a word to the APU. / / Send: / Start-of-Word / Word / End-of-Word / Wait: / Done / Send: / 1) Add-Word-to-User-Dictionary (if loading user dict.) / or / 2) Verfiy-Word / / CALL: JMS SNDWRD / / Inputs: / / WRDSIZ - word size / WRDBUR - buffer containing the word / INIUSR - 0 if loading user dictionary, -1 otherwise /M008 / /---------- SNDWRD, XX / Routine to send word to be tested to APU. / SNDWD1 moved inline since edit no.011 /A011 / eliminated the other call to it /A011 /d011 JMS SNDWD1 / Use common routine to send the word. /d011 SNDWD1, XX / Routine to send word & wait for DONE. TAD (PCSTWD) / Send 'start word' code. JMS SNDAPU / ... TAD WRDSIZ / Get word size. CIA / ... DCA T1 / Save for izzy loop. TAD (WRDBUF-1) / save address of word. DCA X0 / ... SNDXX1, TAD I X0 / Get char. JMS SNDAPC / send char. ISZ T1 / loop on word size. JMP SNDXX1 / .... TAD (PCENWD) / Send "end word" code. JMS SNDAPU / ... JMS GETAPU / Wait to make sure the word was received. -12 / A maximum of 10 seconds. PCDONE;SNDXX2 / Acknowledgement of word. 0 / That's the only return we want! /d011 SNDXX2, JMP I SNDWD1 / Return to caller. SNDXX2, TAD INIUSR / Are we loading the user dictionary? /M011 SMA CLA / Skip if: verify word. /M008 TAD (PCADWD-PCVRFY) / Add word to user dictionary. TAD (PCVRFY) / Verify word. JMS SNDAPU / Send code. JMP I SNDWRD / Return to caller. /---------------- / /GETAPU / /CALL: JMS GETAPU / -# / arg;addr / arg;addr / ... / 0 / / this routine handles the PCRDBK (read block) request internally, / All other returns are checked against the caller return list. / If the return is not in the caller return list, a FATAL error is / declared. The number immediately following the call is the time-out / wait. / /------------ GETAPU, XX / Entry point. TAD I GETAPU / Get the time-out maximum. ISZ GETAPU / Bump the pointer past the value. DCA TIMER / Set up the counter for the wait loop. DCA TIMES / Clear wait loop flag. GTNEXT, JMS GETZ80 / Get character from the APU. TAD (-PCRDBK) / Is it requesting a BLOCK to be READ? SNA / Skip if no. JMP RDBLCK / Jmp to READ a BLOCK. TAD (PCRDBK) / restore original response. CIA / Save negative of response. DCA T1 / Save in a temp for compare against list. GTLOOP, TAD I GETAPU / Get next arg in return list. SNA / Skip if not end of list. JMP GTOOPS / OOPS! return code not in return list. TAD T1 / See if return matches list entry. SNA CLA / Skip if no. Try next entry. JMP GTEXIT / JMP to take exit & process return. ISZ GETAPU / Bump to ISZ GETAPU / next entry. JMP GTLOOP / & try again. GTEXIT, ISZ GETAPU / Point to address of address to return to. TAD I GETAPU / Get return address argument. DCA T1 / save for indirect. JMP I T1 / Take return. RDBLCK, JMS GETZ80 / Get type of file to read (RAM Load/Dict.). DCA T3 / save. JMS GETZ80 / Get lo byte of block #. DCA T1 / save. JMS GETZ80 / Get hi byte of block #. DCA T2 / Save that too. TAD T1 / Check lo byte for validity. AND (7400) / ... SZA CLA / Skip if all is OK. JMP BADBLOCKNUMBER / JMP if passed bad number. TAD T2 / Check for validity. AND (7760) / HI bits should be zeros. SZA CLA / Skip if all is well. JMP BADBLOCKNUMBER / Jmp if block is out of range. TAD T2 / Get hi byte of block #. CLL BSW / Shift 6 bits. RTL / shift 2 more bits (8 in all). TAD T1 / Add in the LO byte. DCA T2 / save. / / Map the relative block # stored in T2 to an abosolute block #. First, / determine which file to map to. / / T3: / 2 - master lexicon / 3 - RAM load file / TAD (RAMFIL) / (-3) TAD T3 / File number to map to. SNA / Skip if: not RAM load file. JMP RAMLOD / RAM load file read request. IAC / Bump the contents of the AC. SZA CLA / Skip if: master lexicon JMP DSKERR / Invalid read request. AC0002 / Master lexicon file starts in block 3. TAD T2 / Add offset to relative block number. TAD (-377) / Compare to block 377 (reserved). SMA / Skip if: block number below 377. IAC / Bump absolute block number by one. TAD (377) / Restore offset. JMP RDBLC1 / Continue. RAMLOD, / Read from RAM load file. / / Check to see that we have not completed the initialization / process. If we have completed, and come here, error.. / TAD FILNUM / Get the # of the file we are reading. TAD T3 / Compare to the file # requested SZA CLA / Skip if: requested expected file. JMP DSKERR / Error. Completed init. shouldn't be here. TAD T2 / Relative block number. TAD RAMLST / Plus starting location of RAM load file./M004 RDBLC1, DCA T2 / Creates block number to read. TAD (PCSTBK) / Send START of BLOCK. JMS SNDAPU / ... TAD T2 / Get block #. JMS PUTBLK / Read the block. TAD (PCENBK) / Send END of BLOCK. JMS SNDAPU / ... JMS GETZ80 / Wait for answering 'DONE'. TAD (-PCDONE) / Check response. SNA CLA / Skip if not correct 'DONE' response. JMP GTNEXT / Go handle the next APU request. JMP GTOOPS / Report error. RAMLST, 377 / Start of American ramload file. /A004 / patched at run time if British /A004 /------------ PAGE / / Incorrect spelling of word has been found ... / ERRGCOR, JMS SETABS DCA WDOFST / initialize the correct word list pointer TAD HALTFG / Are we GOLD:HALTed? SZA CLA / Skip if no. See if any corrections available. JMP ERRHLT / Jmp to enter user menu via GOLD:HALT. TAD CORACT / Is Corrector active? /A002 SNA CLA / Skip if yes. /A002 JMP ERRCORNA / else take CORrector Not Active path /A002 TAD (PCNXWD) / get next possible word code JMS SNDAPU / JMS GETAPU / get response -17 / Time-out maximum - 15 seconds. PCNOMR;ERRNCOR / no correction available PCSTWD;ERRWCOR / successful completion, corrections avail. 0 / ERRHLT, JMS DISERRMSG / menus AC0004 / set default menu option to CONTINUE. JMP ERRMRG / Merge below to display the default option. ERRWCOR, JMS GETWDS / get the correct words AC0001 / rtn1 - no more corrections after these DCA RTNSTS / rtn2 - still more corrections JMS DISWRD / display words to user AC0001 / highlight JMS ARRMOV / to hi-lite the first option JMS RFXMUP / replace menus CLA / enter here on error w/corrections JMP ERRMRG / ERRNCOR, JMS NCORRECT / no corrections available NOP / routine currently takes rtn+1 ERRCORNA, / spelling corrector option not active /A002 JMS DISERRMSG / menus AC0001 / enter here on error w/no corrections / AC - 0 or 1 ERRMRG, DCA OFFSET / set up default offset to menu table TAD OFFSET / set up a flag depending on our status DCA WDSAVL / if set, no words available TAD WDSAVL / DCA LEVEL / set level according to status ERRMR1, JMS MENULINE / display the menuline w/default option bolded ERRMR2, JMS SPOTCR / position the cursor / JMP MNUINP / get users input /---------- / / ROPSHUN - user has selected the replace option / /---------- ROPSHUN, TAD VIDEO / Is the word in error highlighted? SPA SNA CLA / Skip if yes. JMP NORPLC / NO. Report error. TAD WDSAVL / Are there words available? SZA CLA / skip if: words available JMP NORPL1 / No words to replace. TAD LEVEL / Check which level we are on. SNA CLA / Skip if: on menu level. JMP ROPSH0 / Correct list level, replace w/selected word DCA LEVEL / Set level to correct list. AC0001 / hi-lite JMS ARRMOV / The currently active word. JMS RFXMUP / Re-paint the prompt line JMP MNUINP / Wait for more input. ROPSH0, JMS SETREL / set mode to relative / / Set up a pointer to the word chosen / to be replacing the word in error. / TAD WDOFST / word # in the correct word list CLL CML RAL / set up a pointer to the address /m019 TAD (WDTABLE) / within the offset table / DCA T3 / save pointer to address TAD I T3 / get the address in the AC / JMS RCOPTN / Call REPLACE edit code. COPSHUN, / COPSHUN - Continue OPtion merge point. / User has selected the continue option. TTABL1, JMS SETABS / set mode to absolute CIFTXT JMS I (CALIOA) CLREOS / clear the bottom of the screen 1400 NOP JMS MNUPNT / re-paint the menu line JMS SETREL / set relative mode JMP SCCONT / and continue / / No word hi-lited (or available), cannot replace... / NORPL1, JMS PUTERR / output error message /M008 NOEDT / no hi-lited /A008 JMP MNUINP / wait for more input /A008 NORPLC, JMS PUTERR / output error message /M008 NOCORRECT / none available /A008 /d008 DCA NORPL / .... /d008 JMS PUTERR / output error message /d008NORPL, .-. / / JMP MNUINP / wait for more input /---------- / / EOPSHUN - user has selected the edit option / /---------- EOPSHUN, / rtn2 - edit JMS EFXMUP / edit menus / JMS SETREL / set mode to relative JMS ECOPTN / Call EDIT code. JMP TTABL1 / rtn1 - end of edit (CR detected) / fix up screen, join main scroll loop JMS SETABS / rtn2 - (gold menu) - set mode to absolute AC0004 / set default mode DCA OFFSET / to finish JMS RFRSCN / refresh the screen JMS DISERRMSG / finish painting the screen JMP ERRMR2 / listen for input /---------- / / IOPSHUN - user has selected the ignore option / /---------- IOPSHUN, / rtn3 - ignore / TAD VIDEO / Is error word highlighted? SPA SNA CLA / SKip if yes. IGNORE option is valid. JMP NORPLC / JMP if no. cannot ignore if word not hilighted. TAD IOPSHNW / get add word code / w or w/o add to NW list/M008 JMS SNDAPU / add word to user word list JMS GETAPU / get response -12 / Time-out maximum wait - 10 seconds PCUSDF;IOPSH2 / user dictionary full PCDONE;COPSHUN / done ADD function PCDUPL;COPSHUN / Word already in dictionary. Ignore error. IFNDEF UPDICT < 0; 0 > / Update not implemented - all others fatal/A008 IFDEF UPDICT < PCENNW;COPSHUN >/ New Word list full/A008 / Say nothing /M012 0 / all other returns are fatal IOPSHNW, / When ignore is chosen we... /A008 IFDEF UPDICT / Start out adding to NW list /A008 IFNDEF UPDICT / Add to user dict'ry only /A008 / / IOPSH2 moved for space reasons edit no. 002 /---------- PAGE /---------- / / MNUINP - get users input at menu level / / / CALL: JMP MNUINP / /---------- MNUINP, JMS IPTCHR / get a char from the user / char is returned in the AC SMA / skip if: special character /A008 AND P137 / mask to 7 bits & uppercase /A008 DCA INPCHR / save the char / JMS PUTERR / clear any error messages BLANKL / .... / MNUIN1, TAD (MNTABL-2) / set up a pointer to the allowable inputs DCA X1 / .... TAD INPCHR / restore for compares JMS DSPTCH / dispatch to appropriate routine / return if: char not in dispatch table /d008 TAD INPCHR / restore the char /d008 SPA / skip if: not special char /d008 JMP ILLEGAL / invalid input /d008 AND P137 / mask to 7-bit and upper-case /d008 DCA INPCHR / .... /d008 TAD (MNTABL-2) / set up a pointer to the allowable inputs /d008 DCA X1 / .... /d008 TAD INPCHR / restore for compares /d008 JMS DSPTCH / dispatch to appropriate routine /d008 / return if: char not in dispatch table ILLEGAL, CLA / Clear AC incase special char is in it. JMS PUTERR / display error message NOPTION / JMP MNUINP / wait for valid input /----- / Replace, Edit, Ignore, Continue, Finish, or Overview option requested /----- MNUIN3, TAD LEVEL / what level are we on? SZA CLA / skip if: correct list level JMP MNUIN4 / menu line level already AC7777 / un-hi-lite JMS ARRMOV / the currently selected word AC0001 / set to menu level. DCA LEVEL / ... MNUIN4, TAD (-MNTABL) / pointer to start of input list TAD X1 / create an offset into the table CLL RAR MNUIN5, DCA OFFSET / save the offset JMS DISERRMSG / menus JMP ERRMR1 / and wait for more input MNUIN6, TAD CORACT / is corrector active? /A002 SNA CLA / skip if yes. /A002 JMP ILLEGAL / else corrector NOT active, Replace illegal/A002 JMP MNUIN4 / continue processing /A002 / / User has struck RETURN, hand off to the appropriate routine. / EXMNUINP, TAD OFFSET / set up an offset to the appropriate routine TAD (TRNTBL) / thru the transfer table DCA T1 / save TAD I T1 / address of routine DCA T1 / ... JMP I T1 / and goto the routine / / allowable inputs to main menu / / - ORDER IMPORTANT - / MNTABL, -"R+200;MNUIN6 / replace / new branch - is Corrector active?/M002 -"E+200;MNUIN3 / edit -"I+200;MNUIN3 / ignore -"C+200;MNUIN3 / continue -"F+200;MNUIN3 / finish -"O+200;MNUIN3 / overwrite / -"M+200;MORE / more -EDHELP;HOPSHUN / help key -EDUPAR;UPARRO / up arrow -EDDNAR;DNARRO / down arrow -EDADVN;ADVNCE / right arrow -EDBKUP;BCKUP / left arrow -EDNWLN;EXMNUINP / CR 0 / terminator / / allowable routines after recieving a RETURN / TRNTBL, ROPSHUN / replace EOPSHUN / edit IOPSHUN / ignore COPSHUN / continue EOF / finish HOPSHUN / help / / - END ORDER IMPORTANT - / /---------- / / HOPSHUN - Help OPtion / / User has selected the help option. / /---------- HOPSHUN, TAD LEVEL / what line are we on? SNA CLA / skip if: menu line AC7777 / correction list, enter routine w/AC=(-1) JMP HLPKEY / display the help menu /---------- / / UPARRO - UP ARROw / / Up arrow key was struck at user input level. / If [on corrections list level] / Then / error / Else / If spelling corrector activated /A002 / Then /A002 / hi-lite active replacement word (if available) /M002 / Else /A002 / error /A002 / /---------- UPARRO, TAD LEVEL / What level are we on? SNA CLA / Skip if: on mene level. JMP ILLEGAL / Correct list level, error TAD VIDEO / Is the word in error highlighted? SPA SNA CLA / Skip if yes. JMP NORPLC / NO. Report error. JMS CORCHK / skip if corrector is active /A002 JMP ILLEGAL / else correct list level, error /A002 TAD WDSAVL / Check for replacement words available SZA CLA / Skip if: no words available JMP NORPL1 / display error msg and wait for input DCA LEVEL / Set to corrections list level DCA OFFSET / Set to replace AC0001 / Hi-lite replacement word JMS ARRMOV / ... JMS RFXMUP / Replace menus JMP ERRMR1 / Position cursor and wait for input. /---------- / / DNARRO - DowN ARROw / / Down arrow key was struck at user input level. / If [on menu level] / Then / error / Else / un-hi-lite selected replacement word / hi-lite edit / /---------- DNARRO, TAD LEVEL / What level are we on? SZA CLA / Skip if: on correct list level JMP ILLEGAL / Menu level, error IAC / Set DCA LEVEL / Menu level AC7777 / Un-hi-lite JMS ARRMOV / Currently selected word AC0001 / Set to edit JMP MNUIN5 / Hi-lite edit and wait for more input / following moved here for space reasons edit no. 002 IOPSH2, JMS PUTERR / display error msg. - 'user dictionary full' UDFULL JMP MNUINP / wait for some other response IOPSH3, TAD (PCADWD) / get code to just add word to user dict/A008 DCA IOPSHNW / & put into ignore option routine /A008 / so no more words will be added to new /A008 / word list in this session /A008 JMS PUTERR / display error msg. - 'new word list full'/A008 NWFULL JMP MNUINP / wait for input /A008 /---------- PAGE /---------- / / MORE - / / User typed 'M' at input level. / /---------- MORE, TAD RTNSTS / are there more corrections available SZA CLA / skip if: more corrections available JMP MORE1 / no more corrections available TAD WDSAVL / are there words to begin with? SZA CLA / skip if: words JMP NORPL1 / no words available, error AC0001 / set DCA MOORE / to indicate displaying (for STATTR) TAD LNCLMR / set up the line and column # to hi-lite <...> SPA CLA / ... AC0001 / ... TAD SIXTEN / ... DCA LYNE / ... TAD LNCLMR / ... AND P3777 / ... DCA COLL / ... PUTCHR; ESC / output an escape sequence CIFTXT / position the cursor JMS I (CALIOA) / TXTSTR / LYNE, .-. / line COLL, .-. / column TAD (MORDIS) / pointer to DCA DISMO1 / ... JMS SETRV / set reverse video TAD (SNL) / want to hi-lite with the same DCA STATT1 / attributes as the selected word JMS STATTR / set correct attributes JMS DISMORE / re-paint JMS CLRRV / clear attributes JMS SPOTCR / re-position cursor for input TAD (-WDTABLE) / calculate the number of words TAD X3 / ... CLL RAR / ... IAC / bump count by one DCA WDOFST / point to next word DCA MOORE / clear flag JMP GETM0 / get the words MORE1, JMS PUTERR / Display ENDCOR / No more corrections JMP MNUINP / wait for valid input MOORE, 0 / flag to indicate painting / BCKUP - ADVNCE routine moved for space reasons edit no. 002 /---------- / / GETWDS - routine to read correct word list from the Z80 / / / CALL: JMS GETWDS / rtn1 / end of corrections / rtn2 / still more corrections available / / Routine will fill up the correct word buffer with / input supplied from the Z80, and build a count of / the number of characters in the buffer. / /---------- GETWDS, XX / return address TAD (WDLIST-1) / set up a pointer to the correct word buffer DCA X0 / .... DCA CURLSZ / initialize the char count TAD (-12) / set up time-out maximum time - 10 seconds DCA TIMER / ... DCA TIMES / clear wait loop flag / GETWD1, JMS GETZ8C / get a char from the Z80 TAD (-PCENWD) / is it the end of word, (end of input)? SNA / skip if: some other char JMP GETWD2 / end of input, wait for status. TAD (PCENWD) / restore the char DCA I X0 / and store in the buffer. ISZ CURLSZ / bump the char count JMP GETWD1 / and loop 'till done. / GETWD2, JMS GETAPU / get status -12 / Time-out maximum wait - 10 seconds. PCNOMR;GETWD4 / no more corrections PCDONE;GETWD3 / more corrections available 0 / all others are fatal / GETWD4, CIFTXT / JMS I (CALIOA) / Display ENDCOR / No more corrections available 2700 / NOP / JMP GETWD5 / normal exit GETWD3, ISZ GETWDS / bump return if more corrections GETWD5, JMP I GETWDS / normal return if no more corrections / following routines moved here for space reasons edit no. 002 /---------- / / EFXMUP - / / Fix up the screen prior to resuming the edit session. / /---------- EFXMUP, XX CIFTXT JMS I (CALIOA) / clear to end of screen CLREOS / ... 1400 / starting from line 15 NOP / (filler) / CIFTXT JMS I (CALIOA) MSGRP2 2300 2200 / edit menu line / JMP I EFXMUP /---------- / / RFXMUP - Replace menus / /---------- RFXMUP, XX CIFTXT JMS I (CALIOA) REPRMT / replace menus 2300 2400 JMP I RFXMUP /---------- / / /---------- NCORRECT, XX / return address JMS CORCHK / skip if corrector is active /A002 JMP NCOREXIT / else just exit w/o display /A002 / CIFTXT JMS I (CALIOA) NOCORRECT / display no corrections message 1500 NOP / (filler) / NCOREXIT, ISZ NCORRECT / routine takes return+1 /M002 JMP I NCORRECT / return to caller /---------- PAGE /**************************************************************************** /****** W A R N I N G - T H I S P A G E B L A S T E D ****** /**************************************************************************** / SPHOLE is defined in WPF1, and hence will cause an assembly error if /a019 / moved from here. /a019 SPHOLE=. /a019 / / Control passed here when user strikes the HELP key / HLPKEY, DCA SAVAC / save the AC upon entry / JMS SETABS / set mode to absolute JMS SETRV / set reverse video / CIFTXT JMS I (CALIOA) RVHELP / display header 1400 NOP / (filler) / TAD HLPLEN / # of 'spaces' to output DCA T3 / as a counter TAD (ECSPC) / output the remainder of the header JMS OPTCHR / ... ISZ T3 / ... JMP .-3 / ... / TAD SAVAC / restore AC: 0=top level of help / -1=second level of help (replace) / +1=second level of help (edit) SNA / skip if: second level JMP HELP0 / top help level / TAD (MENU2TABLE) / set up a pointer to the menu header DCA HELP1 / ... TAD SAVAC / restore AC TAD (HELP2TABLE) / set up a pointer to the help menu JMP HELP5 / ... (join common code) / HELP0, TAD OFFSET / set up a pointer to the menu name CLL RAL;IAC / ... TAD (MENUTABLE) / ... DCA HELP1 / TAD OFFSET / set up a pointer to the correct menu TAD (HELPTABLE) HELP5, DCA T3 AC7777 TAD I T3 DCA X4 / CIFTXT JMS I (CALIOA) MENUNM 1477 HELP1, .-. / menu name / JMS CLRRV / clear reverse video JMS STMRGN / set up the scrolling region for the menus JMS SETREL / set relative mode /----- / / Display the HELP menu / /----- HELP2, TAD I X4 / get a text line SNA / skip if: more lines available JMP HELP3 / end of initial input DCA HELP23 / save pointer to menu line / HELP21, TAD HELP25 / Set default NOP for BLANK lines. DCA HELP24 / ... TAD HELP23 / is this the BLANK line? TAD (-BLANK) / ... SNA CLA / Skip if no. Set filler. JMP HELP22 / Go merge for this help line. TAD I X4 / pick up the substring address DCA HELP24 / deposit in the IOA string HELP22, PUTCHR; CR+4000 / Output sequence. LF / .... / CIFTXT / Display the menu line JMS I (CALIOA) / HELP23, .-. / address of the menu line HELP24, .-. / this location can be modified for substrings HELP25, NOP / (filler) JMP HELP2 / loop for rest of menu / HELP3, TAD I X4 / get next menu line SNA / skip if: at end of first screen JMP HELP4 / at end of menu DCA HELP23 / at end of first screen, save ptr. and / check if user wants to continue JMS IPTCHR / get a char / TAD (-EDHELP) / is it the HELP key? SNA / skip if: not the HELP key JMP HELP21 / help key SKP / some other key, exit HELP4, JMS IPTCHR / get a char CLA / throw it away JMS SETRGN / re-set the document scrolling region JMS SETABS / set absolute mode / TAD SAVAC / if coming from edit, refresh screen different SMA SZA CLA / skip if: not in edit session JMP EFIXMP / in process of edit JMS RFRSCN / refresh the screen TAD WDSAVL / get the status TAD (-4) / are we halted? SMA / skip if: not halted JMP HELP6 / halted, no messages TAD (4) / restore value of WDSAVL SZA CLA / skip if: words to display JMS NCORRECT / display -no corrections- message to user JMS DISWRD / display words to user HELP6, TAD LEVEL / if on correction list, must hi-lite word SZA CLA / skip if: on corrections list JMP HELP8 / menu line, wait for more input AC0001 / hi-lite JMS ARRMOV / selected word JMS RFXMUP / paint replace menus JMP ERRMR2 / wait for more input HELP8, JMS DISERRMSG / menus JMP ERRMR2 / wait for input /----- / / Re-paint the screen prior to resuming the edit session / /----- EFIXMP, JMS EFXMUP / re-paint screen JMP ECHPRN / and return to edit /---------- PAGE /**************************************************************************** /****** W A R N I N G - T H I S P A G E B L A S T E D ****** /**************************************************************************** /**************************************************************************** / TSTCHR Moved here to give it breathing space /a019 /**************************************************************************** /----------- / /TSTCHR -- See if current character is ALPHA, NUMERIC, or OTHER. / /CALL: JMS TSTCHR AC=0 on input. / char=other return / char=numeric return / char=alpha-only return / / char is stored in T1 for subsequent reference. / /------------ TSTCHR, XX / Entry point. DCA CHAR / Save character. TSTCND, / Entry point from OVTST /a019 TAD CHAR / Get character. AND P377 / Isolate only the character bits. AND (200) / Test for 8 bit character /a019 SZA CLA / Is the character 8 bit? /a019 JMP TSTALP / Yes, accept all 8 bit chars as ALPHA /a019 TAD CHAR / No, retrieve character /a019 X="a&177 / First check for lower case characters. TAD (-X) / Compare against little "a". SPA / Skip if maybe. JMP TSTUPR / See if upper case. TAD ("a-"z) / See if within lowercase range. SMA SZA / Skip if ALPHA ONLY. JMP TSTOTH / Jmp to take OTHER return. TSTALP, ISZ TSTCHR / ALPHA-ONLY return. TSTNUM, ISZ TSTCHR / NUMERIC return. TSTOTH, CLA / OTHER return. JMP I TSTCHR / Return to caller. TSTUPR, TAD ("a-"A) / See if uppercase character. SPA / Skip if possible UPPERCASE. JMP TSNTAL / Definately not ALPHA-BETIC. See if numeric. TAD ("A-"Z) / See if within ALPHA-ONLY range. SMA SZA / Skip if ALPHA ONLY. JMP TSTOTH / Must be OTHER. JMP TSTALP / Jump to take ALPHA return. TSNTAL, TAD ("A&177) / Normalize. JMS TSTSPC / See if special (".", "-", or "'"). SNA / Skip if no. JMP TSTALP / Treat HYPHEN, PERIOD, and APOSTRAPHE as ALPHA. TAD ("'-"0) / See if numeric. SPA / Skip if maybe. JMP TSTDED / Jmp if NO. Test for start of dead key./m019 TAD ("0-"9) / See if within NUMERIC range. SMA SZA / Skip if yes. JMP TSTOTH / Jmp if no. Must be OTHER. JMP TSTNUM / Take NUMERIC return. X="0&177 TSTDED, TAD (X-ECSTOV) / Test for a start of dead character /a019 SZA / Is it a "Start of Dead"? /a019 JMP TSTOTH / No, it's something else /a019 CDFEDT / Get the pointer into text buffer /a019 TAD I (CURPTR) / from the editor /a019 DCA X3 / Store it in an index register /a019 CDFBUF / Change to buffer field to get text /a019 JMS GETNON / Move the cursor on one character and /a019 / get the next character /a019 AND P177 / Mask off character from mode bits /a019 TAD (-40) / Test for space /a019 SZA / Is it a space? /a019 JMP FOUND8 / No, user dead - so just pass 1st char /a019 JMS GETNON / Get the next character /a019 AND P177 / Mask out mode bits again /a019 TAD (-40) / Test for a required space /a019 SNA / Is it another space? /a019 JMP FOUND8 / Yes, required space - output a space /a019 TAD (40-62) / Is this a multinational character? /a019 SZA CLA / Is it? /a019 JMP FOUND8 / No, is tech or line drawing - seperator/a019 JMS GETNON / Yes, get the next character - this is /a019 / a striped 7 bit of the required 8 bit /a019 AND P177 / Strip any mode bits /a019 ISZ TSTCHR / Prepare to return as ALPHA if multinat/a019 ISZ TSTCHR / ... /a019 TAD (200-40) / Set the 8th bit and prepare for... /a019 FOUND8, TAD (40) / Adding in the 40 subtracted above /a019 DCA CHAR / Save the new version of the character /a019 FINDED, JMS GETNON / Start looking for the "End of Dead" /a019 AND P177 / Strip mode bits /a019 TAD (-ECNDOV) / Test for "End of Dead" /a019 SZA / Is this the end of the dead sequence? /a019 JMP FINDED / No, keep on searching /a019 CDFMYF / Yes, back to home field before... /a019 JMP TSTOTH / Return (inced if ALPHA character) /a019 GETNON, XX / Routine to get the next non-null char /a019 GETNLP, TAD I X3 / pointed to by X3 /a019 SNA / Is this a null? /a019 JMP GETNLP / Yes, get next character /a019 JMP I GETNON / No, return /a019 TSTSPC, XX / Routine to see if passed char is ".", "-", or "'". X=".&177 / AC returns 0 if yes, char - "'" if no. AND P177 / Isolate only the character bits. TAD (-X) / See if period. SZA / Skip if yes. TAD (".-"-) / See if initial dash (hyphen). SZA / Skip if yes. TAD ("--"') / See if initial apostrophe. JMP I TSTSPC / Return 0 for special, char - "'" if not. /**************************************************************************** / LODAPU Blasted out to give TSTCHR breathing space /a019 /**************************************************************************** LODAPU, XX / Hook to LODAPU routine to blast it in /a019 RDF / This needs to be cross-field callable /a019 TAD CIDF0 / so create and store the exit CIF CDF /a019 DCA LAPXIT / instruction /a019 JMS SBHOOK / Call the blaster hook /a019 BLODAP / Blast in the LODAPU routine /a019 LAPXIT, XX / The cross-field CIF CDF return instruc/a019 JMP I LODAPU / Return on compleation of routine /a019 /d019 /d019 /---------- /d019 / /d019 / LODAPU - LOaD the APU /d019 / /d019 /---------- /d019 LODAPU, XX /d019 RDF / Get return field. /d019 TAD CIDF0 / Create a return CIF CDF. /d019 DCA LODXYT / ... /d019 CDFSPL / Map spell field. /d019 DCA I (TIMES) / clear wait loop flag /d019 AC0001 / set /d019 DCA I (UPDCLK) / update clock flag /d019 CDFMNU / Map menu field. /d019 TAD (BUFADR) / Init queue block parameters. /d019 DCA I (CMDBLK+RXQBAD) / Buffer address. /M003 /d019 TAD (CDFTXT) / ... /d019 DCA I (CMDBLK+RXQBFD) / Buffer field. /M003 /d019 DCA I (CMDBLK+RXQRS1) / Init block count to the default (1). /M003 /d019 /d019 TAD (OLL301) / Reset the field 2 lock words. /d019 DCA I (OLL301) / field 5 lock word. /d019 TAD (OLL301) / ... /d019 DCA I (OLL400) / and field 6 lock word. /d019 /d019 TAD I (MUBUF+MNOPTC) / Check for spelling corrector active /A002 /d019 AND (SEDBIT) / ... /A002 /d019 SZA CLA / Skip if not active /A002 /d019 AC0001 / else set and ... /A002 /d019 DCA CORACT / Save CORrector ACTive flag /A002 /d019 /d019 / See if we're loading the user dictionary. /d019 TAD I (MUBUF+MNTMP6) / this will be 6 for SC; 7 for LU. /d019 TAD (-7) / This yields -1 for SC, 0 for LU, or /M008 /d019 / +4 for UD. /A008 /d019 DCA INIUSR / Set the SC/LU/UD indicator. /A008 /d019 /D004 TAD I (MUBUF+MNOPTN) / Get the option word. /d019 /D004 AND (MNRX7X) / Is the APU loaded? /d019 TAD I (MUBUF+MNPULD) / Get the external processor loaded word/A004 /d019 AND (MNRX0X+MNRX1X) / Is the "APU" loaded ? /A004 /d019 /d019 SNA CLA / Skip if yes. check for LU & overwrite. /d019 JMP LODAP1 / APU not loaded. Go load it. /d019 TAD INIUSR / Are we loading the user dictionary? /d019 SZA CLA / Skip if yes. /d019 JMP LODXIT / Normal SC run & APU is already loaded. /d019 TAD I (MUBUF+MNTMP5) / See if OVERWRITE (<>0) option. /d019 SNA CLA / Skip if yes. /d019 JMP LODXIT / For ADD (0) to user dictionary, nothing more to do. /d019 CDFMYF / Back to current field. /d019 TAD (PCINUD) / Tell loaded Z80 to INIT the user dictionary. /d019 JMS SNDAPU / ... /d019 JMP LODAP3 / Go wait for the done status. /d019 /d019 LODAP1, CDFMYF / Back to current field. /d019 IFNDEF DEBUG < / Don't assemble this if going out the comm line. /d019 TAD XPUFLG / Is the external processor an XPU /A004 /d019 SZA CLA / Skip if not .. continue w APU code /A004 /d019 JMP LODXPU / else branch to XPU specific code /A004 /d019 /d019 / loop /d019 /d019 LODAP2, JMS MMCMD / load address - ( 16-bit ) /d019 0!CDBIT!XRBIT / ( 2 byte starting address for data xfer ) /d019 TAD STRTAH / get the starting address ( high order byte ) /d019 JMS SNDAPU / send to APU /d019 TAD STRTAL / ... ( low order byte ) /d019 JMS SNDAPU / send to APU /d019 /d019 JMS MMCMD / load byte count ( 2 bytes ) /d019 1!CDBIT!XRBIT / ... /d019 AC0002 / Hi byte of 1000. /d019 JMS SNDAPU / high order length /d019 JMS SNDAPU / low order 8-bit byte of 1000. /d019 /d019 CIFMNU / Update the date & time display. /d019 JMS I (TIMDSP) / ... /d019 /d019 JMS MMCMD / load data to Z80 RAM - ( until byte count=0 ) /d019 2!CDBIT!XRBIT / ... /d019 TAD STRTBK / block number to load /d019 JMS PUTBLK / output the data /d019 /d019 AC0002 / bump to correct load address /d019 TAD STRTAH / /d019 DCA STRTAH / high byte starting address for next block /d019 ISZ STRTBK / bump to next block /d019 ISZ NMBRBK / bump block count /d019 JMP LODAP2 / more blocks to load /d019 /d019 / until: all blocks loaded /d019 / Now start up the APU & wait for the done code. /d019 /d019 JMS MMCMD / load the PC /d019 33!CDBIT!XRBIT / ( '1B' hex - load register pair ) /d019 TAD (GTAPU1%400) / get starting address /d019 JMS SNDAPU / output the address ( high byte ) /d019 IFNZRO GTAPU1&377 < /d019 TAD (GTAPU1&377) / ... /d019 > / IFNZERO GTAPU1&377 /d019 JMS SNDAPU / ... ( low byte ) /d019 JMS MMCMD / run from RAM /d019 4!CDBIT!XRBIT / ( from saved PC address ) /d019 > /IFNDEF DEBUG /d019 /d019 LODAPM, / Merge from LODXPU /M004 /d019 /d004 TAD I (MUBUF+MNOPTN) / Get options word. /d019 /d004 TAD (MNRX7X) / Add in the 'Z80 loaded' bit. /d019 /d004 DCA I (MUBUF+MNOPTN) / Store new options word. /d019 JMS SETLDB / Go set the load bits /A004 /d019 TAD (RAMFIL) / Set file # to indicate RAM load file reads. /d019 DCA FILNUM / ... /d019 /d019 LODAP3, JMS GETAPU / wait for a response /d019 -36 / Time-out wait maximum - 30 seconds. /d019 PCDONE;LODAP4 / done, exit /d019 0 / all others are fatal /d019 /d019 LODAP4, TAD (MSTRLX) / Set file # to indicate master lex. file reads /d019 DCA FILNUM / ... /d019 /d019 LODXIT, CDFSPL / date field to spell /d019 DCA I (UPDCLK) / clear update clock flag /d019 LODXYT, XX / Return CIF CDF goes here. /d019 JMP I LODAPU / finished loading 1 'something' /d019 /d019 /d019 STRTBK, HMCODE / starting block # /M004 /d019 NMBRBK, -50 / -# of blocks to load / RFXMUP moved for space reasons edit no. 002 / / return to here to ignore.... Moved here edit no. 008 / SCFIX, JMS DISPLY / Refresh the word unreversed video. 0 / Say NOT REVERSED VIDEO. CDFEDT / Compute cursor posn of last char of word. AC7777 / CURPOS currently points to next posn so backup. TAD I (CURPOS) / ... DCA I (CURSOR) / Set current cursor posn to there. JMP SCNEXT / no longer in-line must now make specific jump/a008 /---------- PAGE /---------- / / MENULINE - / / This routine will display the menu line in reverse video mode, / with the currently active menu option bolded. / /---------- MENULINE, XX / save callers return address JMS CORCHK / skip if corrector is active /A002 AC7777 / else factor in bypass of Replace /A002 TAD OFFSET / set up a pointer the the selected option. DCA MENUCURSOR / ... JMS SETRV / set reverse video mode / set up a pointer to the menu options / and display them to the user JMS CORCHK / skip if corrector is active /A002 /A002 SNA CLA / ... /A002 AC0002 / else bypass display of Replace /A002 TAD (MENUTABLE) / DCA POSITION / set up pointer to address of cursor position TAD POSITION / IAC / DCA ADDRESS / set up pointer to address of text string JMS CORCHK / skip if corrector is active /A002 /A002 SNA CLA / ... /A002 AC7777 / else reduce # of options by 1 /A002 TAD (ENDMENUTABLE-MENUTABLE%2) CIA DCA OPTCNT / counter of # of options MENUL1, TAD MENUCURSOR SNA CLA JMS STBOLD / set the bold attribute / CIFTXT JMS I (CALIOA) MENUCONTROL POSITION, .-. / address of ^P ADDRESS, .-. / address of text string address TAD MENUCURSOR SNA CLA JMS CLRBLD / bold is set, clear / AC7777 TAD MENUCURSOR DCA MENUCURSOR / decrement position of pointer / AC0002 / set up to display next option TAD POSITION DCA POSITION AC0002 TAD ADDRESS DCA ADDRESS ISZ OPTCNT JMP MENUL1 JMS CLRRV / clear reverse video JMP I MENULINE / return to caller / CLRBLD, XX / return address JMS CLRRV / clear attributes JMS SETRV / restore reverse video JMP I CLRBLD / return to caller / MENUCURSOR, 0 / position of bolded option OPTCNT, 0 / counter of # of options / EFXMUP moved for space reasons edit no. 002 /---------- / / Display the string: / / or / /---------- DISMORE, XX CIFTXT JMS I (CALIOA) DISMO1, .-. / or LABRKT / left angle bracket RABRKT / right " " JMP I DISMORE / NCORRECT moved for space reasons edit no. 002 /---------- / / RFRSCN - refresh the screen / / / This routine will erase the screen from the bottom / of the scroll area to the bottom of the screen. It / will then re-paint the menu line with the current / option highlighted. / /---------- RFRSCN, XX / return address CIFTXT JMS I (CALIOA) / CLREOS / clear the screen 1400 / starting line to clear from NOP / (filler) / JMS RVBKGRND / paint the background for the main menu / JMS MENULINE / paint the menu line / JMP I RFRSCN / return to caller / This routine is called to display the main error messages to the user DISERRMSG, XX / highlight replace or edit, depending on / whether or not corrected spellings were found CIFTXT JMS I (CALIOA) E1RRLINE / display main error line 23 2300 / display second line first 2400 / and third line second JMP I DISERRMSG / prior to return, reset edit scrolling region IPTCHR, XX / return address JMP IPTCH2 / IPTCH1, CIFSYS JWAIT / IPTCH2, CIFSYS XLTIN JMP IPTCH1 / nothing / JMP I IPTCHR / return to user with char in AC / following moved here for space reasons edit no. 002 /---------- / / BCKUP - / |-- adjust the offset into the menu line, and highlight... / ADVNCE - / / / Control is passed here when either a left or right / arrow key is struck at input level. Check to see / which level we are on. If on corrections list, pass / control to another routine, if menu, move the highlighted / option appropriately and check to make sure the cursor / stays within the limits of the menu line. / /---------- BCKUP, AC7776 ADVNCE, IAC / AC = +/- 1 MQL / save AC TAD LEVEL / which level are we on? SNA CLA / skip if: menu level JMP MOVHILYT / corrections list MQA / restore AC TAD OFFSET / modify current offset into menu table SPA / skip if: moving right TAD (ENDMENUTABLE-MENUTABLE%2) DCA OFFSET / update offset pointer TAD (ENDMENUTABLE-MENUTABLE%2-1) CIA TAD OFFSET / MQL / save for later use /A002 MQA / restore for test /A002 SMA SZA CLA / skip if: within bounds of menu line DCA OFFSET / reset pointer to start of menu line TAD CORACT / is corrector NOT active /A002 TAD OFFSET / AND is Replace function selected /A002 SZA CLA / skip if yes. /A002 JMP ADVBKX / else OFFSET is legal - continue /A002 MQA / restore saved AC (= +1 or -5) /A002 SPA / if it is =1 thats what we want /A002 CIA / else make the -5 a positive value /A002 DCA OFFSET / & save the adjusted pointer /A002 ADVBKX, JMS MENULINE / re-paint menuline /M002 JMS SPOTCR / position the cursor JMP MNUINP / listen for input /---------- / / MMCMD - Send commands to the minimonitor (moved here edit no. 010) / /---------- MMCMD, XX MMCMX, Z80IF / wait for the inbound read complete flag/M004 JMP .-1 / APU not ready to read yet... /d008 CLL CLA / ready for read... TAD I MMCMD / get the command ISZ MMCMD / bump return address MMCMY, Z80WR / send the command /M004 CLA CLL / AC is dirty on return JMP I MMCMD / return to caller /---------- PAGE / paints the correct word list on the screen DISWRD, XX / TAD (WDTABLE-1) / set up a pointer to the word buffer DCA X3 / JMS SAVCUR / save the cursor position / ... / TAD (WDLIST-1) / set up a pointer to the word list DCA X0 TAD (-BUF0LEN) / check to see if the word buffer is full. TAD CURLSZ / ... SZA CLA / skip if: the word buffer is full. JMP PNTLN0 / word buffer is not full. TAD I (WDLIST+BUF0LEN-1) / get the last char in the word buffer. TAD (-ECSPC) / is it a 'space'? SNA CLA / skip if: not a 'space'. PNTLN0, AC7777 / the last valid char in the word buffer is / a 'space' so our count of valid characters / is one too many. TAD CURLSZ / and a counter of the number of chars CIA DCA T1 DCA T2 / current column number DCA ROW / initialize row number for table / CIFTXT JMS I (CALIOA) / position the cursor for paint PCURSTRING 1500 NOP / (filler) / JMS SETRV / set reverse video / PNTLI1, TAD (SZL) / set up proper instruction DCA STATT1 / for set attribute routine JMS STATTR / set up the proper attributes for paint JMS FNDLNXTWRD / find the length of the next word / PNTLI2, TAD I X0 / get a char / DCA HOLDCH / save TAD HOLDCH / restore TAD (-ECSPC) / is the char a space? SNA CLA / skip if: not a space JMS CHKATR / a space, set RV, check for bold / TAD HOLDCH / restore the char JMS OPTCHR / and output it to the screen / ISZ T2 / bump the column # ISZ T1 / more to output? JMP PNTLI4 / jump if so... / JMS CLRRV / clear attributes / JMS FITITT / make sure we can fit the <.......> text / and display the appropriate <.......> text / JMS RSTCUR / restore the cursor position / ... JMP I DISWRD / and return to caller / PNTLI4, ISZ T3 / bump the word char count JMP PNTLI2 / output the rest of the word JMP PNTLI1 / loop for more words / /---------- / / PUTBLK - PUT a 'BLocK' of data to the APU / / / In order that this routine might be able to execute without / the need of knowing which media is being used, whenever a / request to read a block is made, compute the track and sector / number for that block. (That way, DSKHND has all of the info. / it needs regardless of media type.) / / Upon entry: / / AC = block # to read/send / /---------- PUTBLK, XX / compute track & sector for block # DCA T2 / save the block number DCA T1 / initialize counter for division TAD (SCTABL) / pointer to the sector table DCA T3 / ... / / compute the track # / / TRACK # = [ (BLOCK#/(SECTORS per TRACK)) + 1 ] / / and / / compute the sector # / / SECTOR # = [ REMAINDER OF DIVISION FOR TRACK # / AS AN OFFSET INTO THE SECTOR TABLE ] / / TAD T2 / restore ... / loop to divide the block number by 10 PUTBL0, TAD (DIVIZR) / SPA / skip if: not done JMP PUTBL1 / division complete ISZ T1 / counter SZA / JMP PUTBL0 / continue ... SKP / Remainder is 0. PUTBL1, TAD (-DIVIZR) / Restore the remainder. TAD T3 / offset into the sector table DCA T3 / save TAD I T3 / and get the sector # CDFMNU / MENU field. DCA I (CMDBLK+RXQSEC) / set the sector # /M003 CDFMYF / MY field. TAD T1 / get result of division IAC / add 1 CDFMNU / MENU field. DCA I (CMDBLK+RXQTRK) / set the track # /M003 CDFMYF / back to my-field TAD T2 / block # to read. CIFMNU / Map code. JMS I (RDFIO) / read the block RXEPR+4000 / physical (8-bit) read SPA CLA / skip if: no error JMP DSKERR / report the error TAD (HMCODE / get 1st block # of Z80 code /A004 CIA / negate /A004 TAD T2 / add in requested block # /A004 SZA CLA / skip if 1st block of Z80 code /A004 JMP PUTBLX / else bypass further checking /A004 TAD XPUFLG / is it an XPU? /A004 SZA CLA / no, just continue /A004 JMS CHPORT / yes, go change the port assignments /A004 / & masks in the 1st block of code /A004 PUTBLX, TAD (BUFADR-1) / pointer to start of buffer area /M004 DCA X0 / .... TAD (-1000) / counter ( 512 8-bit bytes ) DCA T1 / .... PUTBL3, CDFTXT / data field of data to send to APU TAD I X0 / get a word CDFMYF / back to my-field AND P377 / mask to 8-bit JMS SNDAPU / send word to APU ISZ T1 / bump the count JMP PUTBL3 / loop for all JMP I PUTBLK / return DIVIZR=-12 / 10 sectors/track ( 5.25 inch disk ) /---------- PAGE / This routine finds the length of the next word in the word list, if it / will fit on the current, return to the caller. If the word will not / fit on the current line, set the cursor to the beginning of the next / line and return. FNDLNXTWRD, XX DCA T3 / reset word length count TAD X0 / set up our own pointer to the word list DCA X1 / FNDLN1, TAD I X1 / get a char TAD (-ECSPC) / is it a space? SNA CLA / skip if: not a space JMP FNDLN2 / found the end of a word / ISZ T3 / bump the word char count JMP FNDLN1 / loop for more / / found the end of the word, now see if it will fit on the current line / FNDLN2, TAD T2 / current column # TAD T3 / plus length of next word TAD (-120) / compare to max. # of chars. SMA SZA CLA / skip if: next word fits on current line JMP FNDLN4 / next word won't fit on this line / FNDLN3, TAD T3 / make word length negative for counter CMA DCA T3 / TAD ROW / insert this word into the word buffer TAD T2 IAC DCA I X3 / row and column number AC0001 TAD X0 DCA I X3 / pointer to beginning of word / JMP I FNDLNXTWRD / return to caller / FNDLN4, DCA T2 / reset the column number / CIFTXT JMS I (CALIOA) CURSTR / erase to end of line and 1600 / position the cursor to next row NOP / AC4000 / adjust row number we're displaying on DCA ROW / JMP FNDLN3 / return / This routine moves the highlighted attributes on the correct word list ARRMOV, XX / return address SMA CLA / skip if: removing hi-lite from word TAD (SNL-SZL) / hi-liting new word TAD (SZL) / removing hi-lites DCA STATT1 / set up routine properly JMS STATTR / set modes for current word JMS SETRV / set reverse video TAD WDOFST / word number to modify CLL;RAL / multiply count by 2 TAD (WDTABLE) DCA SPLINC / pointer to line and column number TAD I SPLINC SPA CLA / skip if: positive, line 16 AC0001 / negative, line 17 TAD SIXTEN DCA LINE / line number of first word TAD I SPLINC AND P3777 DCA COL / column number of first word TAD SPLINC IAC DCA WRD / pointer to address of start of first word / PUTCHR; ESC / output an escape to the terminal CIFTXT JMS I (CALIOA) TXTSTR LINE, .-. / address of line number COL, .-. / address of column number / AC7777 TAD I WRD / set up a pointer to the word DCA X4 / ARRMO2, TAD I X4 / get a char DCA TMPWRD / save to output TAD TMPWRD TAD (-ECSPC) / is it a space (end of word)? SNA CLA / skip if: not a space JMP ARRMO3 / end of word / TAD TMPWRD JMS OPTCHR / output the char JMP ARRMO2 / loop for more / ARRMO3, JMS CLRRV / clear reverse video / JMP I ARRMOV / return to caller / SPLINC, 0 / line & column number of a word / if bit 0 on: line 16 / if bit 0 off: line 17 CHKATR, XX / return address JMS CLRRV / clear all attributes JMS SETRV / set reverse video TAD DISATR / attribute of the word in error AND (200) / check for bold SZA CLA / skip if: no bold JMS STBOLD / bold the spaces, also JMP I CHKATR / return to caller /---------- / / SPOTCR - SPOT the CuRsor for input / /---------- SPOTCR, XX CIFTXT / JMS I (CALIOA) / position cursor for input PCURSTRING / 0000 / line,column NOP / JMP I SPOTCR / return /----------- / / CORCHK - CORrector CHecK - see if the Corrector has been activated /A002 / /----------- CORCHK, XX /A002 TAD CORACT / is the Corrector active /A002 SZA CLA / skip if it isn't (take normal return) /A002 ISZ CORCHK / else bump up return address /A002 JMP I CORCHK / return /A002 SCTABL, / sector table ( 5.25 inch disk ) 1;3;5;7;11 2;4;6;10;12 /---------- PAGE / This routine adjusts the cursor pointer to the correct word line and / hands off control to the routine which will paint the line properly. MOVHILYT, MQA / restore AC, = +/- (1) DCA SAVAC / save the AC / AC7777 / clear attributes JMS ARRMOV / clear the bold attribute from the current wrd / TAD SAVAC / restore the AC TAD WDOFST / modify current offset into correct word table SPA / skip if: moving to the right JMP FSTLST / set to last word in line MOVHI1, DCA WDOFST / update offset pointer / TAD (WDTABLE) / pointer to start of table CIA / TAD X3 / pointer to end of table CLL RAR / divide by two CIA TAD WDOFST / are we beyond the end of the table? SMA SZA CLA / skip if: within bounds of table JMP GETMOR / at end of list, see if there are more / MOVHI2, TAD LEVEL / which line are we on? SZA CLA / skip if: on correction list line JMP MOVHI3 / requested more words from the menu line AC0001 / set bold JMS ARRMOV / hi-lite the selected word / MOVHI3, JMS SPOTCR / position the cursor for input JMP MNUINP / wait for more input /----- / / Hi-lited word was the first word in the corrections list, and / the left arrow key was struck, position the hi-lite to the last / word in the list. / /----- FSTLST, CLA / Dirty AC upon entry TAD (-WDTABLE) / Pointer to start of table TAD X3 / Pointer to end of table CLL RAR / Divide to get number of words JMP MOVHI1 / Return to update WDOFST / / / / GETMOR, JMS SPOTCR / position the cursor for input / TAD RTNSTS / get the return status SNA CLA / skip if: no more words available JMP MORE / more words, get them. / / no more corrections GET0, DCA WDOFST / wrap to start of correction list JMP MOVHI2 / hi-lite first correction / GETM0, TAD (PCNXWD) / get next possible word code JMS SNDAPU / / GETMO0, JMS GETAPU / wait for start-of-word -17 / Time-out wait maximum - 15 seconds. PCSTWD;GETM00 / got it.. 0 / all others are fatal GETM00, TAD CURLSZ / save the length of the correct word list DCA HLDSIZ / .... JMS GETWDS / get more words AC0001 / rtn1 - no more correction available DCA RTNSTS / rtn2 - more corrections available JMS DISWRD / display the correct word line TAD HLDSIZ / restore the saved length of the list CIA / compare to TAD CURLSZ / the current length SZA CLA / skip if: we didn't get more words JMP MOVHI2 / hi-lite first new word CIFTXT / JMS I (CALIOA) / Display ENDCOR / no more corrections 2700 / NOP / AC7777 / bump word pointer back TAD WDOFST / .... JMP GET0 / didn't get any more words / / HLDSIZ, 0 / temp storage SAVAC, 0 / save the AC upon entry /---------- / / SCRNINIT - This routine sets up the initial screen display prior / to the start of the corrector portion of the feature. / / 1) Display the document name. / 2) Delimit the scrolling region by solid lines. / 3) Display the main menu line. / 4) Set up the scrolling region to range from lines 3 to 13. / 5) Pass control to the Main Scrolling Loop. / /---------- SCRNINIT, XX / save callers return address RDF / Get return field. TAD CIDF0 / Make a return CIF CDF instruction. DCA SCRNXT / save for the exit. CDFMYF / Map our field for the duration of our stay. JMS SETABS / Set screen orgin mode to ABSOLUTE. JMS DISDOCNAME / display and save document name JMS SOLIDLINE / paint the solid lines TAD INEDIT / Are we currently in edit mode? SZA CLA / Skip if no. Paint just paint menu line. JMP SCRNI1 / Jmp if currently editting. JMS MNUPNT / Paint the menu line. JMP SCRNI2 / Merge below to finish up screen initialization. SCRNI1, JMS EFXMUP / Display 'editting' message. SCRNI2, JMS SETRGN / set up the scrolling region for the / document being corrected / SCRNXT, XX / Return CIF CDF goes here. JMP I SCRNINIT / return to caller SETLDB, XX CDFMNU TAD I (MUBUF+MNFMAT) / Get format word /A004 AND (MNFM3X) / Mask out 'British dictionary' bit /A004 SZA CLA / Skip if NOT British /A004 AC0001 / Set AC=1 if British /A004 IAC / AC=1 American, AC=2 British /A004 TAD I (MUBUF+MNPULD) / Add in external processor loaded word /A004 DCA I (MUBUF+MNPULD) / & save it with new settings /A004 TAD I (MUBUF+MNFMAT) / Get format word again /A004 CDFMYF / Back to current field. AND (MNFM3X) / Mask out 'British dictionary' bit /A004 SZA CLA / Skip if NOT British /A004 TAD (110) / British ramload starts at American+110/M013 TAD RAMLST / Add start of AMerican ramload /A004 DCA RAMLST / & save new start /A004 JMP I SETLDB /---------- PAGE /---------- / / DISDOCNAME - / / This routine will display the document (name & number) / being corrected, centering it on the top line of the screen. / /---------- DISDOCNAME, XX / return address / CIFTXT JMS I (CALIOA) / CLREOS / erase the screen 0 / line to start clearing from NOP / (filler) / / See if we are dealing with the user /A017 / dictionary. If we are exit w/o /A017 / displaying the file name /A017 TAD INIUSR / Get SC/LU/UD indicator /A017 SMA CLA / Skip on SC /A017 JMP DISDO4 / LU or UD - just exit /A017 / CDFMNU /***** / data field to menu TAD I (MUBUF+MNDRV) / Get drive #. DCA DOCDRV / save for IOA. TAD I (MUBUF+MNDOCN) / Get document #. DCA DOCNUM / save that too. AC7777 TAD I (MUBUF+MNFNAM) / set up a pointer to the filename CDFMYF /***** / back to my field DCA X1 / and save the pointer TAD X1 / ... DCA X2 / and save a copy DCA T1 / initialize a counter for length of word / The following 2 routines position the cursor so that the / document name will be centered on the screen / First, find the length of the document name / DISDO1, CDFMNU /***** / data field to menu TAD I X1 / CDFMYF /***** / back to my field SNA CLA / skip if: have not found end of filename JMP DISDO2 / found end of name, exit ISZ T1 / bump counter JMP DISDO1 / and continue / / T1 now contains the length of the word, get the width of the screen / and find the starting location for the paint of the name / / Due to manual wide screen mode spell code cannot enter wide screen /A017 / so the following lines were extraneous & were deleted to make room /A017 / DISDO2, /d017 CDFEDT /***** / edit field /d017 TAD I (SPLTFL) / wide screen? /d017 CDFMYF /***** / my-field /d017 SZA CLA / skip if: normal screen /d017 TAD (32) TAD (45) DCA T2 / pointer to center of screen / TAD T1 / get document name length CLL RAR / divide length by 2 CIA / make negative TAD T2 / subtract from mid-screen DCA DISD2A / set up position to start paint from CIFTXT JMS I (CALIOA) / ... PCURSTRING / ... DISD2A, .-. / ... NOP / (filler) CIFTXT / Display '(drive.doc) ' JMS I (CALIOA) / ... DISTXT / text string. DOCDRV, 0 / drive # of the document. DOCNUM, 0 / document # of the document. DISDO3, / now display the document name CDFMNU /***** TAD I X2 CDFMYF /***** SNA JMP DISDO4 / JMS OPTCHR / output the character / JMP DISDO3 / continue with next / DISDO4, JMP I DISDOCNAME / return to caller /---------- / / SOLIDLINE - / / This routine will paint the 2 lines delimiting the scrolling region. / /---------- SOLIDLINE, XX / callers return address JMS GRAFXS / switch to grafix / JMS SETCNT / set up counter for width of screen / CIFTXT JMS I (CALIOA) PCURSTRING 100 / position cursor to start of line 2 NOP / (filler) JMS LOOPS / display first line / JMS SETCNT / set up counter for width of screen / CIFTXT JMS I (CALIOA) PCURSTRING 1300 / position cursor to start of line 14 NOP / (filler) JMS LOOPS / display second line / JMS GRAFXC / restore SI / JMP I SOLIDLINE / return to caller / / routine to print horizontal line (scan 5) to screen / LOOPS, XX / return address LOOPA, TAD (161) / horizontal line, (scan 5) JMS OPTCHR / print the char ISZ T1 / bump the character count JMP LOOPA / loop for more JMP I LOOPS / return to caller / / routine to set up counter for width of screen / SETCNT, XX CDFEDT / from edit field. TAD I (SPLTFL) / wide screen? CDFMYF / Back to current field. SZA CLA / skip if: narrow screen TAD (64) TAD (120) CIA DCA T1 / counter for number of prints JMP I SETCNT / return /---------- / / RVBKGRND - / / Reverse video the background of the menu line. / /---------- RVBKGRND, XX / return address JMS SETRV / set reverse video mode / CIFTXT JMS I (CALIOA) / position the cursor on the menu line PCURSTRING 2000 NOP / (filler) / TAD MENULEN / length of menu line (-62) DCA T1 / set up as a counter / TAD (ECSPC) / output spaces JMS OPTCHR / ... ISZ T1 / bump the character count JMP .-3 / loop 'till done / JMS CLRRV / clear reverse video / JMP I RVBKGRND / return to caller / MENULEN, -62 / minus the length of the menu line /---------- / / MNUPNT - Paint the initial menu line / /---------- MNUPNT, XX / JMS RVBKGRND / reverse video the background of the menu line AC7777 / DCA OFFSET / clear display at start-up JMS MENULINE / display the menu line JMP I MNUPNT / return /---------- PAGE HELPR, / replace BLANK / screen #1 HLPR1;HYLTWD HLPR2;NOP BLANK BLANK HLPR4;FTMET HLPR5;ULARAK BLANK BLANK BLANK EXIT1;EXIT10 0 0 / HELPE, / edit BLANK / screen #1 HLPE1;HYLTWD HLPE2;NOP HLPE3;NOP BLANK HLPE4;FTMET HLPR5;ULARAK BLANK BLANK BLANK EXIT1;EXIT10 0 0 / HELPI, / ignore BLANK / screen #1 HLPI1;NOP HLPI2;NOP BLANK HLPI3;FTMET HLPR5;ULARAK BLANK BLANK BLANK BLANK EXIT1;EXIT10 0 0 / HELPC, / continue BLANK / screen #1 HLPI1;NOP HLPC1;NOP BLANK HLPC2;FTMET HLPR5;ULARAK BLANK BLANK BLANK BLANK EXIT1;EXIT10 0 0 / HELPF, / finish BLANK / screen #1 HLPF1;NOP BLANK BLANK HLPF3;FTMET HLPR5;ULARAK BLANK BLANK BLANK BLANK EXIT1;EXIT10 0 0 / HELPH, / help BLANK / screen #1 HLPH1;DSPAID HLPH2;NOP BLANK HLPH3;DSPAID HLPH4;HOUMIF HLPH5;NOP BLANK HLPH6;NOP HLPH7;NOP EXIT2;EXIT10 0 BLANK / screen #2 HLPH8;NOP BLANK HLPH9;NOP HLPH90;NOP HLPH0;ULARAK HLPH10;NOP BLANK HLPH11;NOP BLANK EXIT2;EXIT10 0 BLANK / screen #3 HLPH12;NOP BLANK HLPH13;NOP HLPH14;NOP HLPH15;NOP HLPH16;NOP HLPH17;NOP BLANK BLANK EXIT2;EXIT10 0 BLANK / screen #4 HLPH18;HOUMIF HLPH19;HOUMIF BLANK HLPH20;HOUMIF HLPH21;NOP HLPH22;NOP BLANK HLPH24;NOP BLANK EXIT1;EXIT10 0 0 / HELPK, / corrections list BLANK / screen #1 HLPK1;NOP BLANK HLPK2;NOP HLPK3;ULARAK BLANK HLPK4;LABRKT HLPK5;NOP BLANK HLPK7;NOP EXIT1;EXIT10 0 0 / HELPL, / editing the line BLANK / screen #1 BLANK HLPL1;EDIT BLANK HLPL2;OCASD HLPL3;OCASD HLPL4;NOP HLPL5;LABRKT BLANK BLANK EXIT2;EXIT10 0 BLANK / screen #2 HLPL9;NOP BLANK HLPL6;TODELA HLPL7;TODELA HLPL8;GOLD HLPL10;CHRWRD HLPL11;CHRWRD HLPL12;CHRWRD HLPL13;CHRWRD EXIT2;EXIT10 0 BLANK / screen #3 HLPL9;NOP BLANK HLPL14;CHRWRD HLPL15;CHRWRD HLPL16;NOP HLPL17;NOP HLPL18;NOP BLANK BLANK EXIT1;EXIT10 0 0 / HELPTABLE, / table of help menus HELPR / replace HELPE / edit HELPI / ignore HELPC / continue HELPF / finish HELPH / overwrite / HELPK / correct list HELP2TABLE, / table of help menus at second level XX / not used HELPL / editing line / / / This buffer area holds the word as it's scanned by the high level scanner. / WRDBUF, / ZBLOCK MAXCHR / X=. / Since WRDBUF is only in use during high level scan & since WDLIST / is only in use after an error has been detected, both use the same / buffer (WDLIST is the larger). / / This buffer contains the correct word choices. The buffer has a hard / space coded at the end to make sure the buffer always ends with a space. / WDLIST, ZBLOCK BUF0LEN X=. ECSPC X=. / / This buffer is built as new words are received. The reason for the / separate buffer is for moving the cursor and the attributes along / the correct word list. The buffer is set up in the following form: / / line,column;address / WDTABLE, ZBLOCK BUF1LEN X=. /----------- / /SNDAPU - Sends a character/code to the APU. / / /CALL: JMS SNDAPU AC=character to send. / /Return AC=0 & character is sent. All waiting done by this routine. / /------------- IFDEF DEBUG < / Assemble this version to debug across comm line. SNDAPU, XX / Entry point. JMP SNDGO / Merge below. SNDWT, CIFSYS / The APU is busy. Let others run. JSWAP / & then try again. SNDGO, CIFSYS / try sending the character. HS2OU / for now use the host line. JMP SNDWT / Busy. wait & try again. JMP I SNDAPU / Return to caller when done. > / IFDEF DEBUG IFNDEF DEBUG < / Assemble this version to run on the Z80. SNDAPU, XX SNDAP0, MQL / put contents of AC into MQ, clear AC TAD (-20) / iteration count. DCA XFRCNT / save for izzy. TAD (XRBIT) / transfer ready bit MQA / OR MQ back in SNDAP1, Z80IF / Skip on APU inbound read complete flag, JMP SNDAP2 / not ready SNDAPX, Z80WR / send the data out /M004 CLL CLA / AC is dirty on return JMP I SNDAPU / return to caller SNDAP2, ISZ XFRCNT / Bump iszy count. JMP SNDAP1 / count not zero yet. try again. DCA XFRCNT / Save character to send. JMS WTLOOP / Check for time-out. SKP / No time-out yet. continue below. JMP TYMOUT / Report time-out error. TAD XFRCNT / Get character to send. JMP SNDAP0 / restart... XFRCNT, 0 / Iteration count. > / IFNDEF DEBUG /----------- / / GETZ80 - Gets a character/code from the APU. / / / CALL: JMS GETZ80 / / Return: / AC=character sent from the APU. / All waiting done by this routine. If the time limit / that has been set for the particular 'GET' is / exceeded, this routine will hand off to the DYSKER / routine to display the error message. / /------------- IFDEF DEBUG < / Assemble this version to debug across comm line. GETZ80, XX / Entry point. GETAP1, CIFSYS / for now use HS2IN. HS2IN / ... JMP GETAP2 / MQL / save byte / CLA / to be sure... / DCA TIMES / clear wait loop flag / MQA / restore... JMP I GETZ80 / return to caller w/ return byte. GETAP2, JMS WTLOOP / Let other's run. JMP GETAP1 / rtn1 - then try again (more time to wait). JMP TYMOUT / rtn2 - time-out error. > / IFDEF DEBUG IFNDEF DEBUG < / Assemble this version to run in the same machine. GETZ80, XX / Entry point. GETAP0, TAD (-200) / iteration count. DCA XFRCNT / save for loop count. GETAP1, Z80SF / wait for flag JMP GETAP2 / not ready.... GETAPX, Z80RS / get a byte /M004 GETAPY, AND P377 / mask off data I/O channel #. /M004 JMP I GETZ80 / return to caller w/ return byte. GETAP2, ISZ XFRCNT / Bump iszy count. JMP GETAP1 / count not zero yet. try again. DCA XFRCNT / Save character to send. JMS WTLOOP / Check for time-out. SKP / No time-out yet. continue below. JMP TYMOUT / Report time-out error. TAD XFRCNT / Get character to send. JMP GETAP0 / restart... > / IFNDEF DEBUG /---------- PAGE /---------- / / STATTR - SeT ATTRibutes / / This routine must have a location modified prior to calling. If / the correct word list is being displayed, set STATT1 up as a (SZL) / instruction. If the selected word is being hi-lited, set up STATT1 / as a (SNL) instruction. / / Disatr - location containing attributes to be appended / / |0|1|2|3|4|5|6|7|8|9|10|11| / --------------------------- / |*| |*|*|*| |*| | | | | | / --------------------------- / ^ ^ ^ ^ ^ / | | | | | / | | | | \ / | | | | ---> lower case character / | | | \ / | | | -------> bold / | | \ / | | ---------> | 00 - none / | \ | 01 - underscore / | -----------> | 10 - superscript / | | 11 - subscript / \ / ---------------> upper case first character in word ONLY STATTR, XX / return address TAD DISATR / get the attributes word AND (0600) / mask for underline and bold CLL;BSW;RTR / if underline, AC=1; if bold, L=1 DCA HOLDCH / save the AC, (in case underline) STATT1, .-. / (SZL) if setting true word mode / (SNL) if setting hi-lite on selected word JMS STBOLD / send bold escape sequence TAD MOORE / are we displaying ? SZA CLA / skip if: not JMP I STATTR / displaying , no underlines. TAD HOLDCH / restore SZA CLA / skip if: no underline JMS STUNDR / send escape sequence to set underline JMP I STATTR / return to caller / / routine to see that the <.......> text can fit on the first / line of the correct word list. if it can, return to the / caller, otherwise, position the cursor to the start of the / second line for the display. / FITITT, XX AC7777 / bump the word table pointer back TAD X3 / .... DCA T2 / .... AC4000 / mask AND I T2 / get the line # of the last word DCA LNCLMR / .... TAD I T2 / line, column number AND P3777 / column # DCA T1 TAD X3 / pointer to the word table DCA T2 / .... AC7777 / TAD I T2 / index pointer to start of last word DCA X2 / a pointer to the last word on the first line / loop TAD I X2 / get the next char in the word TAD (-ECSPC) / a space? SNA CLA / skip if: not a space, end of word JMP FITIT0 / found end of word ISZ T1 / bump the column number JMP .-5 / find end of word / 'till "space" found FITIT0, AC0001 / 1+ TAD T1 / column # of last char TAD LNCLMR / combine with line # of last word DCA LNCLMR / and save TAD T1 / restore... TAD M107 / compare to the max length allowed SPA SNA CLA / skip if: will not fit JMP FITIT1 / continue CIFTXT / JMS I (CALIOA) / CURSTR / erase to end of line and 1600 / bump cursor to next line for display NOP / TAD (4002) / Set up line/col # for (2nd line,col 1) DCA LNCLMR / ... FITIT1, TAD (ECSPC) / 'space' JMS OPTCHR / output a 'space' at the end of the list TAD RTNSTS / get the return status SZA CLA / skip if: more corrections available TAD (NOMORDIS-MORDIS)/ no more corrections, display TAD (MORDIS) / more corrections, display DCA DISMO1 / set up for display JMS DISMORE / and display the text / JMP I FITITT / return /---------- / / WTLOOP - Wait Loop / / Upon entry: / / TIMER should be set up to indicate the / number of seconds to wait. / / CALL: JMS WTLOOP / rtn1 / have not reached maximum time. / rtn2 / end of wait time reached. / /---------- TIMER, 0 / number of seconds to wait (negative form) TIMER1, 0 / current seconds TIMES, 0 / 0 if first time thru/wait WTLOOP, XX RDF / get return field TAD CIDF0 / make a return CIF CDF instruction DCA WTLOO4 / save for the exit CDFSPL / TAD UPDCLK / Should we update the clock? SNA CLA / Skip if: yes JMP WTLOO0 / don't update the screen clock CIFMNU / Update the time & date display. JMS I (TIMDSP) / ... WTLOO0, TAD TIMER / are we done before we start? SNA CLA / skip if: more time to wait JMP WTLOO3 / waited long enough TAD TIMES / have we been here before SZA CLA / skip if: first time thru JMP WTLOO1 / been here before, don't re-init time CDFSYS / sys-field TAD I (CLOCK+2) / get the seconds CDFMYF / back to my field DCA TIMER1 / save for compares AC0001 / set to indicate first time thru DCA TIMES / ... WTLOO1, CIFSYS / JSWAP / wait for others / CDFSYS / TAD I (CLOCK+2) / get current seconds CDFMYF / CIA / negative for compare TAD TIMER1 / to saved tenths SNA / skip if: change JMP WTLOO4 / no change in time, exit CIA / Restore to new value. TAD TIMER1 / ... DCA TIMER1 / ... /D005 TAD UPDCLK / Get the update clock flag /D005 SNA CLA / Skip if: set /D005 JMP WTLOO2 / Not set /D005 CIFTXT / Set... /D005 JMS I (CALIOA) / Display... /D005 WRKING / Working... /D005 1732 / /D005 1732 / WTLOO2, ISZ TIMER / bump our counter NOP / in case time goes to zero JMP WTLOO4 / exit WTLOO3, DCA TIMES / clear first time thru flag ISZ WTLOOP WTLOO4, .-. / return CIF CDF instruction JMP I WTLOOP / return PORTBL, 11 / XPU status port 10 / XPU data port 100 / XPU output ready mask 1 / XPU input available mask 100 / XPU output ready XOR mask 0 / end of table /---------- PAGE /**************************************************************************** / OVTST Entry point for the TSTCHR routine which drops through /a019 / Start Dead Key Sequence characters /a019 /**************************************************************************** OVTST, XX / The required return address is here /a019 DCA CHAR / The character is placed here /a019 TAD OVTST / Get the required return address /a019 DCA TSTCHR / Pass it to the TSTCHR routine /a019 TAD CHAR / Get the character back /a019 TAD (-ECSTOV) / Test for Start-of-Dead /a019 SZA CLA / Is it Start-Of-Dead? /a019 JMP TSTCND / No, enter the TSTCHR routine /a019 JMP I OVTST / Yes, return as an OTHER character /a019 /**************************************************************************** / LODXPU has been blasted out to join LODAPU /a019 /**************************************************************************** /---------- / / LODXPU - LOad the XPU / / This code is branched to from LODAPU to perform the / the XPU specific stuff involved in loading the Z80. / Control is returned to a merge re-entry point in LODAPU / /---------- /d019 LODXPU, / Z80 address space on the XPU is /d019 / 20000-3FFFF hex (on even byte bounds) /d019 / Segment register=2000h to address this space /d019 JMS MMCMD / Send monitor command /d019 1054 / =22Ch=Write memory segment(MS) register /d019 CLA / Low byte=0 /d019 JMS SNDAPU / Send it to the XPU /d019 TAD (40 / High byte = 20h /d019 JMS SNDAPU / Send it to the XPU /d019 JMS MMSTA / Wait for status returned from monitor /d019 JMS MMCMD / Send monitor command /d019 1053 / =22Bh=Write memory offset(MO) register /d019 TAD STRTAL / Get low byte of starting address /d019 RAL / x2 since we are wrting even bytes /d019 JMS SNDAPU / Send it to the XPU /d019 TAD STRTAH / Get high byte of starting address /d019 RAL / x2 since we are wrting even bytes /d019 JMS SNDAPU / Send it to the XPU /d019 JMS MMSTA / Wait for status returned from monitor /d019 /d019 LODXPN, /d019 CIFMNU / Update the date & time display. /d019 JMS I (TIMDSP) / ... /d019 /d019 JMS MMCMD / Send monitor command /d019 5 / =Write block on even bytes /d019 TAD STRTBK / Get block # to write /d019 JMS PUTBLK / & go write it /d019 TAD (BKDNBIT) / Set BlocK transfer DoNe bit into AC /d019 X80ST / & write it to XPU status register /d019 CLA / Clear garbage left in AC /d019 JMS MMSTA / Wait for status returned from monitor /d019 /d019 ISZ STRTBK / bump to next block /d019 ISZ NMBRBK / bump block count /d019 JMP LODXPN / more blocks to load /d019 /d019 / until: all blocks loaded /d019 /d019 / Now start up the XPU & wait for the done code. /d019 /d019 /d019 JMS MMCMD / Send monitor command /d019 1074 / =23Ch=write z80 PC /d019 TAD STRTAL / Get low byte of starting address /d019 JMS SNDAPU / Send it to the XPU /d019 TAD STRTAH / Get high byte of starting address /d019 JMS SNDAPU / Send it to the XPU /d019 JMS MMSTA / Wait for status returned from monitor /d019 /d019 JMS MMCMD / Send monitor command /d019 11 / =9h=startup Z80 /d019 /d019 JMS MMSTA / Wait for status returned from monitor /d019 JMP LODAPM / Merge back with original stream /----------- / / MMSTA - MiniMonitor STAtus return / /----------- MMSTA, XX TAD (NOP) / Get a "NOP" into AC DCA GETAPY / & put into the "GETAPU" routine to prevent / masking out the high order bits of a valid / monitor response JMS GETAPU / Get output from XPU monitor -5 / Time out after 5 seconds 7400;MMSTAC / =F00h=Normal completion of a monitor command 0 / Any other is fatal MMSTAC, TAD (AND P377) / Get the 'mask to 8 bits' instruction into AC DCA GETAPY / & restore it into the "GETAPU" routine JMP I MMSTA / & Return /---------- / / CHPORT - CHange Z80 PORT assignments for the XPU /A005 / / Called once when loading the 1st block of Z80 code into the XPU / /---------- CHPORT, XX AC0002 / Just return if we are reading the dictn/A018 TAD FILNUM / /A018 SNA CLA / /A018 JMP I CHPORT / /A018 TAD (PORTBL-1) / Point to beginning of XPU port assignment table DCA X0 / & save for auto-index TAD (BUFADR+2) / Point to address in Z80 code where port / assignments are stored (START + 3) DCA X1 / & save for auto-index CHPOLP, CDFMYF / Back to our field TAD I X0 / Pick up entry in table SNA / Skip if there was an entry JMP I CHPORT / AC=0 End Of Table Return CDFTXT / Change to our buffer field DCA I X1 / & store into corresponding address in Z80 code JMP CHPOLP / Go get next entry UPDTPD, TAD (PCADNW) / Get command to add to new word list /A008 DCA IOPSHNW / & store in IOPSHUN routine. We are /A008 / clearing new word list, so adding to /A008 / it will be ok again. /A008 BKPPTR / GET TO BEGINNING OF FILE /A008 SKP /A008 JMP .-2 /A008 GETCHR / ADVANCE PAST RULER /A008 NOP / /A008 CLA CLL / /A008 TAD (-12) / 10 SEC. TIMEOUT /A008 DCA TIMER /A008 DCA TIMES /A008 TAD (PCRTNW) / Tell Z80 to ReTurn the New Word list /A008 JMS SNDAPU /A008 UPDTNX, CLA / Clear possible dirty AC JMS GETAPU / Get the response /A008 -12 / 10 sec. timeout /M010 PCENNW;SPLXIT / End of list - exit spell /A008 PCSTWD;GETNEW / Start of word - get the word /A008 0 / All others fatal /A008 GETNEW, JMS GETZ8C / Get the next character /A008 TAD (-PCENWD) / Check for end of word /A008 SNA / Skip if: NOT end of word /A008 JMP GETEND / End of word - put EOL /M010 TAD (PCENWD) / Restore the original character /A008 INSCHR;ADVPTR;NOP / & put it to file. /A008 JMP GETNEW / Loop for next char /A008 GETEND, TAD (LF) / Put LF to file /M010 INSCHR;ADVPTR;NOP / /M010 JMP UPDTNX / Get next word /A010 /**************************************************************************** / TSTLIN Moved here to make room in page 200 /a019 /**************************************************************************** TSTLIN, XX / Routine to see if word wrapped to next line. CDFEDT / Map edit field. TAD I (SCRLCT) / (get lag counter). CDFMYF / Back to our field. SNA / Skip if we bumped a line. JMP TSTLNX / return if still on same line. JMS UNDOLG / Undo screen lag (via FXSCRL). TAD WRDSIZ / Backup to the start of the word. CIA / ... MOVCHR / posn to start of word. CDFEDT / Map edit field. TAD I (SCRLCT) / See if word still starts on same initial line. TAD LINCNT / compare lag count to line count. SPA SNA CLA / Skip if now we're fewer lines. (accounted for JMP MFIXUP / by wrapping text when modified). JMP if OK. TAD I (SCRLCT) / Reset # of lines to start of word. CIA / ... DCA LINCNT / .... TAD I (CURSOR) / Save CURSOR posn of start of word. DCA SCURSR / ... TAD I (CURPTR) / Save text ptr to start of word. DCA SCURPT / ... TAD SCURSR / Reset start of line pointer. DCA SLCRSR / (cursor posn). DCA NEWLIN / Reset 'new line' indicator since start of line / pointers already initialized. MFIXUP, CDFMYF / back to our field. TAD WRDSIZ / Get distance to where we were. MOVCHR / Go there. TSTLNX, JMP I TSTLIN / Return to caller. /---------- PAGE FIELD 3 / This is the auxillary field. / note that the editor loads into 6400-7777 / of this field. Also note that several / editor routines use some of the globaly / defined temps (X0, X1, X2, T1, etc.) *200 / Start assembling code at 200. BUFADR, / Buffer for I/O starts here. CDFMYF=CDFTXT / A CDF to this field. /d015 ZBLOCK 400 / Reserve 2 pages for start of 1000 word buffer. ZBLOCK 200 / Only one page is necessary now as XPU /A015 / code has pushed the resident code up /A015 / & we need the space. /A015 /---------- PAGE /---------- / / CHKAPU - CHecK the APU / / / This routine, checks to be sure that the APU board is present. / If so, it then performs a mini-self-test to see that it is / functioning proporly. If either of these tests fail, set up / a pointer to an error message, and take the normal return to / display the error message, otherwise, take a return+1. / / / CALL: JMS CHKAPU / rtn1 / error / rtn2 / APU is present & OK / /---------- CHKAPU, XX RDF / Get return field. TAD CIDF0 / ... DCA CHKAP3 / Save for the return trip home. AC0001 / Set flag allows for updating of screen clock CDFSPL / Spell field DCA I (UPDCLK) / Update clock flag CDFMNU / See if APU has been loaded already. TAD I (MUBUF+MNOPTN) / Get options word. AND (MNRX7X) / See if the XPU bit is set. /M004 DCA XPUFLG / & save for later use /A004 TAD I (MUBUF+MNPULD) / Get external processor loaded word /A004 AND (MNRX0X+MNRX1X) / Mask out American/British loaded bits /A004 SZA CLA / Skip if both bits are 0...APU not loaded./M004 JMP CHKAP1 / APU is loaded, so skip the self-test. CDFMYF / Now map our field. TAD XPUFLG / See which device to start up /A004 SZA CLA / Skip if it is APU (XPUFLG NOT set) /A004 JMP CHKXPU / Else go to XPU start up routine /A004 Z80LI / No APU interrupt. (AC=0) JMS WAKAPU / Start the APU and wait for it to answer JMP APUINC / rtn1 - APU incompatible or failure JMP APUBAD / rtn2 - APU failure JMS WAKAPU / Reset the APU and wait for another flag JMP APUINC / rtn1 - APU incompatible or failure JMP APUBAD / rtn2 - APU failure / Test the data communications channels used for all data / and command I/O. Send a byte of data to the APU, which / will echo the byte back with a walking '1' in the address / field, until a 'command' byte is received. AC4000 / Zero on right, walking '1' on left. CHKAPA, DCA TEMP2 / Store in temp2. TAD TEMP2 / Restore. AND P377 / 8-bit mask. SNA CLA / First time through? JMP CHKAPC / Don't wait first time through. TAD (-200) / Set maximum number of retries. DCA INTTIM / Into the internal timer. CHKAA1, CLL CLA / Z80IF / Wait for inbound read complete flag. SKP / Not ready, test for timed out. JMP CHKAPC / ready, continue test ISZ INTTIM / Bump our internal timer (counter). JMP CHKAA1 / Continue waiting. JMP APUBAD / Timed out. CHKAPC, TAD TEMP2 / Restore temp2. AND P377 / 8-bit mask. MQL / AC into MQ TAD (XRBIT) / Transfer ready bit. MQA / 'OR' MQ back into AC. Z80WR / Put out temp2. CLL CLA / Dirty AC after call. TAD (-200) / Set maximum number of retries. DCA INTTIM / Into the internal timer (counter). CHKAC1, CLL CLA / Z80SF / Test the inbound data ready flag. SKP / Not ready, test for timed out. JMP CHKAPD / Ready, continue. ISZ INTTIM / Bump the timer. JMP CHKAC1 / Continue to wait. JMP APUBAD / Timed out, error. CHKAPD, Z80RS / Get the data from the APU. CIA / Make negative for compare. TAD TEMP2 / To the expected value SZA CLA / Skip if: interface OK, so far. JMP APUBAD / Interface test failed. TAD TEMP2 / Get back old expected value. IAC / Bump data portion up by 1. AND P377 / Mask out upper bit. SNA / Skip if: more testing to do. JMP CHKAPZ / Finished this test. MQL / New data value into MQ CLA / To be sure! TAD TEMP2 / Old value for rotate. AND (7400) / Just these 4-bits. CLL RAR / Rotate right 1-bit. DCA TEMP2 / Save as new temp2. TAD TEMP2 / Restore. TAD (-200) / Have we rotated too far? SZA CLA / Skip if: too far. JMP .+3 / Not too far, TEMP2 is OK. AC4000 / SKP / TAD TEMP2 / Here is rotate was OK. MQA / 'OR' in data stored in MQ JMP CHKAPA / Loop ... / Now, let the APU do its RAM test. First, send any command. CHKAPZ, TAD (CDBIT!XRBIT) / Turn on command bit. Z80WR / Put out temp2. CLL CLA / Dirty AC after call. TAD (-10) / Wait for 10 seconds. CDFSPL / data field to spell. DCA I (TIMER) / ... CDFMYF / Back to my field. CHKAP0, CIFSPL / Instruction field to spell. JMS WTLOOP / For RAM test to complete. SKP / rtn1 - not finished wait. JMP APUBAD / rtn2 - wait completed. Z80SF / Skip on device falg. JMP CHKAP0 / Not ready. Z80RS / Get the data from the APU. TAD (-7401) / Should be 'f01' (hex). SZA CLA / Skip if: OK. JMP APUBAD / Failed RAM test. / Successfully completed the APU Self-Test. CHKAP1, ISZ CHKAPU / bump on success return CHKAP2, /D004 CLA / Clear update clock flag CDFSPL / Spell field DCA I (UPDCLK) / Clear update clock flag /M004 TAD XPUFLG / See if we need to put patches in main /A004 / spell code for XPU. /A004 SZA CLA / Skip if APU /A004 JMS PATXPU / Else go do XPU patches /A004 CHKAP3, XX / Return CIF CDF instruction goes here. JMP I CHKAPU / return to caller INTTIM, 0 / Internal timer (counter). TEMP2, 0 / Temp storage for the I/O tests. /---------- PAGE /---------- / / RSTAPU - ReSeT the APU / /---------- RSTAPU, XX CLA TAD (RBIT) / get the reset bit Z80WR / RESET / / The sequence RESET/RELEASE RESET does not clear the APU outbound / data available flag, nor does it clear (entirely) the data coming / from the APU. Hence, the next 5 instructions were added to make / sure that the data available flag does get cleared, so that when / a read is issued, expected data is returned (no error condition). / /----- / Z80DF / set APU outbound data available flag Z80SF / skip on APU outbnd data avail. flg, clear it JMP .-1 / wait for flag Z80SF / just in case (H/W) NOP / / /----- / CLL CLA / clear dirty AC Z80WR / RELEASE RESET CLL CLA / clear dirty AC JMP I RSTAPU / return /---------- / / WAKAPU - Wake up the APU / / Reset the APU, wait for 3 seconds, and see if / we got a response back. / /---------- WAKAPU, XX JMS RSTAPU / reset the APU AC7775 / maximum of 3 seconds. CDFSPL / data field to spell DCA I (TIMER) / ... CDFMYF / back to my field WAKAP0, CIFSPL / instruction field to spell JMS WTLOOP / wait loop SKP / rtn1 - not finished wait. JMP WAKAP1 / rtn2 - wait completed - never heard / check if device 14 has signalled ... Z80SF / skip if: APU flag set JMP WAKAP0 / never heard from the APU Z80RS / get the data from the APU TAD (-7400) / make sure it's 'F00' (hex) SNA CLA / skip if: wrong response ISZ WAKAPU / good response, bump return ISZ WAKAPU / wrong response WAKAP1, CDFSPL / data field to spell DCA I (TIMES) / clear wait loop flag CDFMYF / JMP I WAKAPU / return+1 if OK, normal return otherwise. / / error detected, display appropriate error message before returning. / APUINC, TAD (INCAPU-BADAPU) / APU incompatibility APUBAD, TAD (BADAPU) / APU failure DCA APUBA1 / Set up for display CIFMNU / Do a MENU call to display the message. JMS I IOACAL / ... 0 / Display to the screen. APUBA1, .-. / Error message ptr. -2700 / arg1 ASTRNG / arg2 THREST / arg3 JMS WAITRT / Wait for a return. JMP APUBAD / Something else was typed. Repeat error. JMP CHKAP2 / normal return on error WAITRT, XX / Routine to wait for 1st input char & check it. JMP BADAP2 / Merge below. BADAP1, CIFSYS / JWAIT for a bit. JWAIT / ... BADAP2, CIFSYS / Get an input character. XLTIN / ... JMP BADAP1 / Loop & wait if none. TAD (-EDNWLN) / Return typed? SNA CLA / Skip if no. Return to repeat error. ISZ WAITRT / Take success return. JMP I WAITRT / return to caller. /----------- / / WTIDRD - WaiT for xpu Input Data ReaD flag /A005 / /----------- WTIDRD, XX AIDRD, X80IF / Skip if XPU has read input data SKP CLA / else go wait a bit JMP I WTIDRD / RETURN CIFSPL / Change to spell field JMS WTLOOP / Check for timeout, etc. JMP AIDRD / No timeout - try again JMP APUBAD / Timeout error /----------- / / WTODAV - WaiT for xpu Outbound Data AVailable flag /A005 / /----------- WTODAV, XX AODAV, X80SF / Skip if XPU has output data available SKP CLA / else go wait a bit JMP I WTODAV / RETURN CIFSPL / Change to spell field JMS WTLOOP / Check for timeout, etc. JMP AODAV / No timeout - try again JMP APUBAD / Timeout error /---------- / / RSTXPU - ReSeT the XPU / /---------- RSTXPU, XX CLA TAD (RSETBIT) X80LI / / The sequence RESET/RELEASE RESET does not clear the XPU outbound / data available flag, nor does it clear (entirely) the data coming / from the XPU. Hence, the next 6 instructions were added to make / sure that the data available flag does get cleared, so that when / a read is issued, expected data is returned (no error condition). / /----- / AC0001 /M006 X80DF / set XPU outbound data available flag /M006 X80SF / skip on XPU outbnd data avail. flg, clear it/M006 JMP .-1 / wait for flag /M006 X80SF / just in case (H/W) /M006 NOP / /M006 / /----- / CLL CLA / clear dirty AC X80LI CLL CLA / clear dirty AC JMP I RSTXPU / return /---------- / / WAKXPU - Wake up the XPU / / Reset the XPU, wait for 3 seconds, and see if / we got a response back. / /---------- WAKXPU, XX JMS RSTXPU / reset the XPU AC7775 / maximum of 3 seconds. CDFSPL / data field to spell DCA I (TIMER) / ... CDFMYF / back to my field WAKXP0, CIFSPL / instruction field to spell JMS WTLOOP / wait loop SKP / rtn1 - not finished wait. JMP WAKXP1 / rtn2 - wait completed - never heard / check if device 17 has signalled ... X80SF / skip if: XPU flag set JMP WAKXP0 / never heard from the XPU X80RS / get the data from the XPU DCA XTMP1 ISZ WAKXPU / good response, bump return ISZ WAKXPU / wrong response WAKXP1, CDFSPL / data field to spell DCA I (TIMES) / clear wait loop flag CDFMYF / JMP I WAKXPU / return+1 if OK, normal return otherwise. /---------- PAGE /--------- / / PATXPU - PATch the spell code with XPU specific IOTs, etc. / /--------- PATXPU, XX TAD (PATTBL-1) / Get address of patch table-1 DCA X0 / & save for auto-indexing PATXLP, CDFMYF / Change to our field TAD I X0 / Get address to be patched SNA / Skip if valid address (.NE. 0) JMP I PATXPU / else RETURN DCA T1 / Save address TAD I X0 / Get patch CDFSPL / Change to spell field DCA I T1 / & put in the patch JMP PATXLP / Loop back for the next PATTBL, GETAP1 ;X80SF GETAPX ;X80RS SNDAP1 ;X80IF MMCMX ;X80IF SNDAPX ;X80WR MMCMY ;X80WR XPUFLG ;1 / This signals the code in the spell field / that it is dealing with an XPU 0 /------------ / / CHKXPU - CHecK the XPU /A005 / / Branched to from CHKAPU to perform the XPU specific startup / and self-test handshaking. Takes same error path as CHKAPU / & branches back to CHKAPU on successful completion / /------------ CHKXPU, /d007 7402 / **temp** X80LI / No XPU interrupt. (AC=0) JMS WAKXPU / Start the XPU and wait for it to answer JMP APUINC / rtn1 - XPU incompatible or failure JMP APUBAD / rtn2 - XPU failure JMS WAKXPU / Reset the XPU and wait for another flag JMP APUINC / rtn1 - XPU incompatible or failure JMP APUBAD / rtn2 - XPU failure TAD (-12) / Set AC=-10 decimal. Allow 10 secs. for / completion of self-test. CDFSPL / Change data field to spell & DCA I (TIMER) / Set the timer. CDFMYF / Back to our field. JMS WTODAV / Wait for xpu to signal it has output ready /note: this code is adapted directly from the self test performed under / CP/M which waits for output but then ignores it (an error !?!?) / Probably should be an X80RS etc. here, but when in Rome .... X80WR / Send xpu anything CLA CLL / Clear garbage JMS WTIDRD / Wait for xpu to signal input data read CLA CLL / Clear garbage TAD (TIMRBIT) / Set RS.TIMR bit in XPU RSTATUS register X80ST / ... CLA CLL / Clear garbage JMS WTODAV / Wait for xpu to signal it has output ready X80RS / Get output from XPU DCA XTMP1 / & save it TAD (BKDNBIT) / Set RS.BKDN bit in XPU RSTATUS register X80ST / ... CLA CLL / Clear garbage JMS WTODAV / Wait for xpu to signal it has output ready X80RS / Get output from XPU DCA XTMP1 / & save it TAD (ATTNBIT) / Set RS.ATTN bit in XPU RSTATUS register X80ST / ... CLA CLL / Clear garbage JMS WTODAV / Wait for xpu to signal it has output ready X80RS / Get output from XPU DCA XTMP1 / & save it AC0001 / Initialize the starting pattern TEST1B, DCA XTMP2 / Save the pattern AC7776 / Set inner loop counter for 2 patterns DCA INSCNT / ... TEST1C, TAD XTMP2 / Get the pattern X80WR / Send it to the XPU CLA CLL / Clear garbage JMS WTIDRD / Wait for xpu to signal input data read JMS WTODAV / Wait for xpu to signal it has output ready X80RS / Get output from XPU DCA XTMP1 / & save it TAD XTMP2 / Get back pattern originally sent CIA / Negate it TAD XTMP1 / Add in what XPU returned SZA CLA / Skip if the same JMP APUBAD / else report error TAD XTMP2 / Get the pattern just sent CMA / Complement it DCA XTMP2 / & save the new pattern ISZ INSCNT / Update the inner loop counter JMP TEST1C / Did floating 1 - now do floating 0 TAD XTMP2 / Get the pattern CLL RAL / Shift the floating 1 once left SNL / Skip if we've been through every bit JMP TEST1B / else go do this pattern CLA CLL / Clear garbage TAD (BKDNBIT) / Tell the XPU we're finished sending data X80ST / ... CLA CLL / Clear garbage JMS WTODAV / Wait for xpu to signal it has output ready X80RS / Get output from XPU DCA XTMP1 / & save it TAD XTMP1 / Get it back TAD (-7401) / See if it was F01h=Monitor ready after reset SZA CLA / Skip if it was JMP APUBAD / else report error / Because of the difference between the way / the APU & XPU start up the following is / done to prevent a timeout from occurring / in the routine MMCMD the first time it is / entered. AC0002 / Set the XPU input data read flag X80DF / ... CLA CLL / Clear garbage CDFSPL / Change to spell field DCA I (TIMES) / Clear wait loop flag JMP CHKAP1 / Merge back into CHKAPU stream XTMP1, 0 XTMP2, 0 INSCNT, 0 /---------- PAGE /---------- / / / Jms Calioa / **** / arg1 (text string) / **** / arg2 / **** / arg3 / /---------- CALIOA, XX TAD I CALIOA / pick up the text string address DCA CALIO1 / ... ISZ CALIOA / bump to next location TAD I CALIOA / pick up next arg DCA CALIO2 / ... ISZ CALIOA / bump to next location TAD I CALIOA / pick up next arg DCA CALIO3 / ... ISZ CALIOA / bump for return RDF / Get field of caller. TAD CIDF0 / Make return CIF CDF. DCA CALIO4 / save for the return. CDFMYF / Map our field. / CIFMNU JMS I IOACAL 0 CALIO1, .-. CALIO2, .-. CALIO3, .-. CALIO4, XX / return CDI JMP I CALIOA / return to caller / / / SPINCK - SPell INitial ChecK , See that document file was opened / & if not report, Check what operation to do. / ADDED EDIT NUMBER 015 / / SPINCK, XX RDF / Get field of caller TAD CIDF0 / Make return CIF CDF DCA SPINEX / & save for the return TAD I SPINT0 / Get the SC/LU/UD indicator /M016 CDFMYF / Map our field SWP / Save indicator in MQ for now / & get open file flag into AC SNA CLA / Skip on open file JMP SPINFO / File open failed - inform user ACL / Get back SC/LU/UD indicator SPA SNA CLA / Skip on SC or LU ("Normal" return) SPINT1, ISZ SPINCK / Increment return ("Skip") SPINEX, XX / Return CDI JMP I SPINCK / Return to caller SPINFO, JMS CALIOA / Clear screen from 2nd line down CLREOS 0100 NOP JMS CALIOA / Give "Document could not be opened..." msg FOMGTX 1404 NOP JMP SPFOIP / Go look for GOLD MENU (actually any key) SPFOWT, CIFSYS / Wait for an event JWAIT / ... SPFOIP, CIFSYS / See if user struck a "key" XLTIN / ... JMP SPFOWT / Not yet - Go wait CLA / Get rid of it ISZ SPINCK / Bump the return address JMP SPINT1 / Go bump the return again & exit (Double "Skip") SPINT0, INIUSR / INIUSR is zero page, so we need this /A016 / literal to get at it from this field /A016 /---------------------------------------- / / ***** C A U T I O N ***** / the next locations are order important / /---------------------------------------- MENUTABLE, / table of menu options 2000; REPLACE / 'replace' option 2012; EDIT / 'edit' option 2021; IGNORE / 'ignore' option 2032; CONTINUE / 'continue' option 2045; FINISH / 'finish' option 2056; OVERVIEW / 'overview' option ENDMENUTABLE=. / end of table / CORRECT / correct list help header MENU2TABLE, / headers for help menus at second level XX / not used EDTING / editing line help header /---------------------------------------- / / end order important / /---------------------------------------- /**************************************************************************** / / The next routine has been inserted to deal with correction of /a019 / words containing 8-bit characters. It emulates the editor 8-bit/a019 / expansion routine, without calling the screen update routines /a019 / /**************************************************************************** ECIMCH, XX / 8 bit character/dead key expansion rtn/a019 DCA EC8 / Save the character /a019 TAD EC8 / Get it back /a019 AND (200) / Check for 8 bit data /a019 SNA CLA / Is it 8 bit? /a019 JMP ECN8BT / No, output it normally /a019 TAD EC8SPC / Get the space of the dead sequence /a019 AND P177 / Mask out previous attributes /a019 TAD I (DISATR) / Add the attributes in /a019 DCA EC8SPC / Restore the space with the attributes /a019 TAD EC8CST / Get the character set identifier /a019 AND P177 / Mask off previous attributes /a019 TAD I (DISATR) / Add the attributes in /a019 DCA EC8CST / Restore the identifier /a019 TAD EC8 / Get the character /a019 AND P177 / Mark off the 8th bit /a019 TAD I (DISATR) / Add in the attributes /a019 DCA EC8 / Restore the character /a019 CDFMYF / Back to my field /a019 TAD (EC8STR-1) / Get addr of dead seq. string /a019 DCA X4 / Save in an index register /a019 EC8LOP, TAD I X4 / Get the next character in the dead seq/a019 SNA / Is it the end of the string? /a019 JMP EC8RTN / Yes, exit via CIDF instruction /a019 JMS ECIMCR / No, insert the character into the text/a019 JMP EC8LOP / Get the next character in the seq. /a019 ECN8BT, TAD EC8 / Get the 7 bit character /a019 TAD I (DISATR) / Add in the attributes /a019 CDFMYF / Return data to here /a019 JMS ECIMCR / Insert it into the text buffer /a019 EC8RTN, CDISPL / Place for CIDF instruction /a019 JMP I ECIMCH / Return /a019 ECIMCR, XX / Routine to call the editor INSERT rtn /a019 CDFSPL / Change to Spelling data field /a019 DCA I (T3) / Store the character in insert param /a019 CIFSPL / Change to the spelling field /a019 JMS ECD8IN / Call INSERT /a019 JMP I ECIMCR / Return to caller /a019 EC8ATT, 0 / Attributes of the 8 bit character /a019 EC8STR, ECSTOV / Dead string to insert for 8 bit char /a019 EC8SPC, " / Space alternate char set introducer /a019 EC8CST, "2 / Multinational character set selector /a019 EC8, 0 / Location for storage of character /a019 ECNDOV / End of dead sequence /a019 0 / End of string /a019 /---------------- PAGE FOMGTX, TEXT /^P&DOCUMENT COULD NOT BE OPENED. &PRESS !&GOLD !&MENU TO //A015 *.-1 /A015 TEXT /RETURN TO MAIN MENU./ /A015 INCAPU, TEXT /!X^P^A&BOARD INCOMPATIBILITY OR FAILURE.^S!Y/ BADAPU, TEXT /!X^P^A&BOARD FAILURE.^S!Y/ ASTRNG, BELL; ESC; "[; "0; ";; "7; "m&177; 0 / Ring bell; set reverse Video. NOMEAN, TEXT /^P&THAT COMMAND HAS NO MEANING HERE./ ERREOL, TEXT /^P&END OF LINE REACHED. &CANNOT EDIT BEYOND THIS LINE./ ERRBOL, TEXT /^P&START OF LINE REACHED. &CANNOT EDIT BEFORE THIS LINE./ ERRSWP, TEXT /^P&INVALID SWAP./ FATAL, TEXT '^P&READ/&WRITE ERROR. &VERIFY YOUR DISKETTE OR &Z80 BOARD.' *.-1 TEXT ' &PRESS !&RETURN.' THREST, TEXT / &PRESS !&RETURN./ TIMERR, TEXT /^P&TIME-OUT ERROR. &PRESS !&RETURN TO RETURN TO &MAIN &MENU./ NWFULL, /A008 TEXT /^P&NEW WORD LIST FULL. &WORDS IGNORED FROM NOW ON WILL NOT//A008 *.-1 TEXT / BE INCLUDED IN AN UPDATE/ /A008 UDFULL, TEXT /^P&TEMPORARY MEMORY FULL. &CANNOT IGNORE ANY MORE WORDS./ UDFUL2, TEXT /^P&PERSONAL DICTIONARY TOO LARGE. &PRESS !&RETURN./ ESCAPE, 33;0 LABRKT, 74;0 RABRKT, 76;0 ERASE, TEXT /!E/ BLANKL, PCURST, TEXT /^P/ CURSTR, TEXT /!L^P/ CLREOS, TEXT /^P!E/ MENUCONTROL, TEXT /!P!S/ CONTROL, TEXT /^A/ TXTSTR, TEXT /&[^D;^D&H/ MENUNM, TEXT /^P&!S/ DISTXT, TEXT /(^D.^D) / REPLACE, TEXT /&REPLACE/ EDIT, TEXT /&EDIT/ IGNORE, TEXT /&IGNORE/ CONTINUE, TEXT /&CONTINUE/ FINISH, TEXT /&FINISH/ OVERVIEW, TEXT /&OVERVIEW/ CORRECT, TEXT /&CORRECTIONS &LIST/ EDTING, TEXT /&EDITING THE &LINE/ RVHELP, TEXT /^P!E &H &E &L &P/ /D005WRKING, /D005 TEXT /^P ^P...&WORKING.../ E1RRLINE, TEXT /^P!L&SELECT AN OPTION WITH !&ADVANCE OR !&BACKUP, / *.-1 TEXT /OR TYPE THE LETTER. &PRESS !&RETURN./ *.-1 TEXT /^P!L&FOR MORE INFORMATION, PRESS THE !&HELP KEY./ NOPTION, TEXT /^P!L&INVALID CHOICE - &SELECT ANOTHER OPTION./ NOCORRECT, TEXT /^P!L&NO CORRECTIONS AVAILABLE FOR THIS WORD./ MSGRP2, TEXT /^P!L&FOR MORE INFORMATION, PRESS THE !&HELP KEY./ *.-1 TEXT /^P!L&EDIT AND PRESS !&RETURN. !&OR PRESS &GOLD !&MENU TO RETURN / *.-1 TEXT /TO &SPELLING &MENU./ REPRMT, TEXT /^P!L&SELECT AN ALTERNATE WITH !&ADVANCE OR !&BACKUP / *.-1 TEXT /AND PRESS !&RETURN. !&OR TYPE / *.-1 TEXT /^P!LA LETTER FOR AN OPTION. &FOR MORE INFORMATION,/ *.-1 TEXT / PRESS THE !&HELP KEY. / NOEDT, TEXT /^P!L&NO ERROR HIGHLIGHTED. &SELECT ANOTHER OPTION./ ENDCOR, TEXT /^P&NO MORE CORRECTIONS AVAILABLE FOR THIS WORD./ MORDIS, TEXT /^A&MORE...^A/ NOMORDIS, TEXT /^ANO MORE^A/ HYLTWD, TEXT / THE ERROR (HIGHLIGHTED/ FTMET, TEXT / FROM THE MENU, EITHER TYPE / ULARAK, TEXT /USING THE !&BACKUP AND !&ADVANCE KEYS/ DSPAID, TEXT /&D&E&CSPELL / HOUMIF, TEXT /&HOUGHTON &MIFFLIN/ BLANK, TEXT // HLPR1, TEXT / &LETS YOU REPLACE^S WORD) WITH A WORD FROM/ HLPR2, TEXT / THE CORRECTIONS LIST. &THIS LIST APPEARS JUST BELOW THE TEXT./ HLPR4, TEXT / &TO SELECT &REPLACE^S&R, OR HIGHLIGHT &REPLACE/ HLPR5, TEXT / ^S. &THEN PRESS !&RETURN./ EXIT1, TEXT /^SKEY./ EXIT10, TEXT / &TO EXIT HELP, PRESS ANY / HLPE1, TEXT / &LETS YOU EDIT THE LINE WHICH CONTAINS^S/ HLPE2, TEXT / WORD). &YOU CANNOT EDIT ANY OTHER LINE. &IF YOU ADD OR DELETE ANY/ HLPE3, TEXT / WORDS THE TEXT WILL BE REFORMATTED./ HLPE4, TEXT / &TO SELECT &EDIT^S&E, OR HIGHLIGHT &EDIT/ HLPI1, TEXT / &CONTINUES CHECKING THE DOCUMENT, LEAVING THE HIGHLIGHTED WORD/ HLPI2, TEXT / UNCHANGED. &ANY FURTHER OCCURRENCES OF THE WORD ARE IGNORED./ HLPI3, TEXT / &TO SELECT &IGNORE^S&I, OR HIGHLIGHT &IGNORE/ HLPC1, TEXT / WORD UNCHANGED./ HLPC2, TEXT / &TO SELECT &CONTINUE^S&C, OR HIGHLIGHT &CONTINUE/ HLPF1, TEXT / &LEAVES &D&E&CSPELL. &THE DOCUMENT IS UPDATED TO INCLUDE ANY / *.-1 TEXT /CORRECTIONS./ HLPF3, TEXT / &TO SELECT &FINISH^S&F, OR HIGHLIGHT &FINISH/ HLPH1, TEXT / ^SDETECTS AND CORRECTS SPELLING MISTAKES AND CAPITALIZATION/ HLPH2, TEXT / ERRORS IN ANY SELECTED DOCUMENT./ HLPH3, TEXT / ^SCHECKS EACH WORD USING A DICTIONARY BASED UPON &AMERICAN/ HLPH4, TEXT / &HERITAGE &DICTIONARIES PUBLISHED BY ^S AND USING/ HLPH5, TEXT / YOUR OWN PERSONAL DICTIONARY, TO WHICH YOU CAN ADD WORDS./ HLPH6, TEXT / &WORDS THAT ARE NOT IN THE DICTIONARIES ARE HIGHLIGHTED AS ERRORS./ HLPH7, TEXT / &YOU CAN CORRECT OR IGNORE ERRORS USING OPTIONS FROM THE MENU./ EXIT2, TEXT / &FOR MORE HELP, PRESS THE !&HELP KEY.^SOTHER KEY./ HLPH8, TEXT / &TO SELECT AN OPTION FROM THE MENU:/ HLPH9, TEXT / . &TYPE THE FIRST LETTER OF THE OPTION AND PRESS !&RETURN./ HLPH90, TEXT / &O&R/ HLPH0, TEXT / . &HIGHLIGHT THE OPTION ^S AND/ HLPH10, TEXT / THEN PRESS !&RETURN./ HLPH11, TEXT / &TO RECEIVE HELP ON THAT OPTION, PRESS THE !&HELP KEY INSTEAD OF / *.-1 TEXT /!&RETURN./ HLPH12, TEXT / &THE FOLLOWING OPTIONS ARE AVAILABLE FROM THE MENU./ HLPH13, TEXT / !&REPLACE - LETS YOU REPLACE THE ERROR WITH A CORRECTION./ HLPH14, TEXT / !&EDIT - LETS YOU EDIT THE LINE CONTAINING THE ERROR./ HLPH15, TEXT / !&IGNORE - IGNORES THE ERROR AND ALL FURTHER OCCURRENCES OF IT./ HLPH16, TEXT / !&CONTINUE - IGNORES THE ERROR./ HLPH17, TEXT / !&FINISH - LEAVES &D&E&CSPELL; THE DOCUMENT IS UPDATED TO THIS POINT./ /HLPH71, /TEXT / &M - DISPLAYS MORE CORRECTIONS (IF ^A&MORE...> IS DISPLAYED)./ HLPH18, TEXT / ^S &SPELLING &VERIFICATION - &CORRECTION,/ HLPH19, TEXT / (C) ©RIGHT 1983, 1981, ^S. &ALL RIGHTS STRICTLY RESERVED./ HLPH20, TEXT / &CONTAINS CONFIDENTIAL UNPUBLISHED PROPERTY OF ^S,/ HLPH21, TEXT / LICENSED SOLELY FOR USE IN &DIGITAL SOFTWARE. &REPRODUCTION, DISCLOSURE, / HLPH22, TEXT / OR RE-CREATION OF EMBODIED COMPUTER PROGRAMS OR ALGORITHMS PROHIBITED./ HLPH24, TEXT / &D&E&CSPELL, (C) COPYRIGHT !&DIGITAL &EQUIPMENT / *.-1 TEXT /&CORPORATION 1983/ HLPK1, TEXT / &A LIST OF POSSIBLE REPLACEMENTS FOR THE ERROR./ HLPK2, TEXT / . &TO INSERT A REPLACEMENT INTO THE TEXT, HIGHLIGHT THE WORD/ HLPK3, TEXT / ^S, THEN PRESS !&RETURN./ HLPK4, TEXT / . &TO DISPLAY MORE CORRECTIONS (IF ^A&MORE...> IS DISPLAYED), PRESS / HLPK5, TEXT / THE &A&D&V&A&N&C&E KEY WHEN THE HIGHLIGHTING IS ON THE LAST/ *.-1 TEXT / CORRECTION./ HLPK7, TEXT / &TO RETURN TO THE MENU, TYPE THE LETTER OF THE DESIRED MENU OPTION./ OCASD, TEXT / ONE CHARACTER AND SET DIRECTION / TODELA, TEXT / TO DELETE A / GOLD, TEXT / !&GOLD / HLPL1, TEXT / &^S THE WORDS ON THE LINE USING THE FOLLOWING KEYS:/ HLPL2, TEXT / !&ADVANCE - TO MOVE FORWARD^SFORWARD/ HLPL3, TEXT / !&BACKUP - TO MOVE BACK^SBACKWARD/ HLPL4, TEXT / !&WORD - TO MOVE ONE WORD IN SET DIRECTION/ HLPL5, TEXT / ^A-- --> - TO MOVE ONE CHARACTER IN EITHER DIRECTION/ HLPL6, TEXT / !&RUBOUT !&KEY OR !&DEL !&CHAR -^SCHARACTER/ HLPL7, TEXT / !&RUBOUT !&KEY OR !&DEL !&WORD -^SWORD/ HLPL8, TEXT / !&GOLD !&DEL !&WORD,^S!&DEL !&CHAR - TO RECOVER ERASED TEXT/ HLPL9, TEXT / &OTHER KEYS AVAILABLE:/ HLPL10, TEXT / !&UPPER !&CASE - TO CAPITALIZE^S/ HLPL11, TEXT / !&GOLD !&UPPER !&CASE - TO LOWER-CASE^S/ HLPL12, TEXT / !&BOLD - TO BOLD^S/ HLPL13, TEXT / !&GOLD !&BOLD - TO UN-BOLD^S/ HLPL14, TEXT / !&UNDERLINE - TO UNDERLINE^S/ HLPL15, TEXT / !&GOLD !&UNDERLINE - TO REMOVE UNDERLINE FROM^S/ HLPL16, TEXT / !&SWAP - TO SWAP CHARACTERS/ HLPL17, TEXT / !&HYPH !&PUSH - MOVES FIRST CHARACTER IN LINE UP TO PREVIOUS LINE/ HLPL18, TEXT / !&GOLD !&HYPH !&PULL - MOVES LAST CHARACTER IN PREVIOUS LINE DOWN TO / *.-1 TEXT /CURRENT LINE/ CHRWRD, TEXT / A CHARACTER OR WORD/ /------ PAGE NOPUNCH /WPSFF.PA / ******* EDIT HISTORY ******* / /010 WJY 29-SEP-84 Fix bug #293 - use ruler imbedded in control / block like printer. /009 BC 20-JUL-84 Fix footnote w/dead keys; Field 5&6 lock words /008 BC 6-JUL-84 Change WPS FOOTNOTE RULER to FOOTNOTE /007 BC 26-JUN-84 Fixes bug with footnote after New Page Mark. /006 BC 20-JUN-84 Delete check for superscpt # before footnote /005 BC 18-JUN-84 Support footnote rulers (defined in ctrl blks) / Delete code leftover from spelling. /004 BC 4-JUN-84 Enable read/write of footnote text to scratch / area of utility disk. Allow GOLD HALT abort. /003 BC 30-MAY-84 Add error messages, speed footnote cutting. / Increase size of scrolling region. /002 BC 24-MAY-84 Add minimal footnote algorithm /001 SBB 14-APR-84 INITIAL VERSION / FIELD 0 / Write out code. *200 / Set up for write-out. JMP I .+2 JMP I .+2 RXLOAD 7605 *RXLDLS RXEWT;0;RXQBLK;. DLOFFF;100;CDF 20;-DSOFFF / Write-out primary spell-check code. / DLOSPX;200;CDF 30;-DSOSPX / Writeout auxillary IOA & text code. 0 FIELD 2 / Assemble FOOTNOTE FORMATTER code in field 3. CDFSPL=CDFMTH CIFSPL=CIFMTH CDISPL=CDIMTH CDFMYF=CDFSPL CDFTXT=CDFLP / Text field is field 5. CIFTXT=CIFLP / ... CDITXT=CDILP / / Page 0 values. *100 SCURSR, 0 / Saved CURSOR value for start of word. SCURPT, 0 / Saved CURPTR value for start of word. LINCNT, 0 / # of lines word crosses. CHAR, 0 / Saved char from TSTCHR routine. NEWLIN, 0 / Flag to indicate that a NEW LINE has been scrolled. OFFSET, 0 / pointer to the option requested ECERFL, 0 / # 0 When there is an error msg being displayed. IFDEF OLDSPL < /A003 HYPHEN, 0 / - == scan 'till hyphen seen. / 0 == no hyphen seen. / + == word is hyphenated. NOTWRD, 0 / "NOT WORD" indicator. # 0 means NOT A WORD. WRDSIZ, 0 / Word size thus far. DISATR, 0 / Contains attributes word for REPLACE replacement words. SLCRSR, 0 / CURSOR value of 1st word on current line. ELINCT, 0 / counter as to which line user is on during EDIT. RLINCT, 0 / counter as to which line is the restart line UNDLCT, 0 / count of # of characters in undeleted buffer NOINSR, 0 / # 0 when INSERT not allowed. NOMORE, 0 / # 0 when at end of current line. ECMODE, 0 / current MODE of EDIT processing. WDOFST, 0 / pointer to the correct word requested LEVEL, 0 / active menu line: 0/corr. list, 1/menu INPCHR, 0 / char input by user to menu CURLSZ, 0 / current logical size of correct word list RTNSTS, 0 / return status code SIXTEN, 16 / row 16 M107, -107 / minus (107) LNCLMR, 0 / line & column # of (.......) text TMPWRD, 0 / temp location WRD, 0 / pointer to start of word ROW, 0 / row correct words are being displayed on WRDCNT, 0 / counter of number of words NUMTRY, 0 / number of times user reaches end of C.W.L WDSAVL, 0 / if set, word not found in dictionary HLPLEN, -110 / number of 'spaces' in the HELP header VIDEO, 0 / 1 if error word is highlighted, 0 if not. / Set/Cleared by DISPLY. UPDCLK, 0 / If set, WTLOOP will update the screen clock. STRTAH, 1&377 / high byte starting address to load Z80 from STRTAL, 0&377 / low byte starting address to load Z80 from GTAPU1=400 / starting address to go to ( 100 hex ) INIUSR, 0 / 0 for SC, 1 for LU (loading user dictionary). HOLDCH, 0 / temp for DISWRD routine. FILNUM, 0 / file # the APU should be reading from MSTRLX=-2 / Master lexicon file: file # 2 RAMFIL=-3 / RAM load file: file # 3 > / end ifdef OLDSPL /A003 P137, 137 / 7-bit mask to uppercase HALTFG, 0 / GOLD:HALT flag. Set if GOLD:HALT detected. / Page 0 values for Footnoting /A002 WTHNFN, 0 / = 1 if within a footnote /A002 APFN, 0 / = 1 if autopaginating footnotes /A002 FNRLSN, 0 / = 1 if footnote ruler seen /A002 FNOTP, 0 / = 1 if footnotes on this page /A002 FNLTP, 0 / = # of footnote lines, this page /A002 PGESFN, 0 / = # of pages worth of footnotes /A002 FNBPLP, 0 / ->next put entry in footnote buffer list (-1) /A002 FNBPCT, 0 / = count of room in footnote put buffer /A002 FNBPPT, 0 / ->next word in footnote put buffer /A002 FNBGLP, 0 / ->next get entry in footnote buffer list (-1) /A002 FNBGCT, 0 / = count of room in footnote get buffer /A002 FNBGPT, 0 / ->next word in footnote get buffer /A002 FNDLAD, 0 / = address of footnote delimiter string /A002 FNODSK, 0 / = 1 if footnotes spilled over to disk /A003 FNFDSK, 0 / = 1 if started reading footnote text from disk/A003 FNWSPC, 0 / = minus # blocks avail. for writing ftnt text /A003 FNRSPC, 0 / = minus # blocks avail. for reading ftnt text /A003 FNRFLG, 0 / = 0 if no footnote ruler encountered /A005 SLNMOD=JMS I .;ECSLMD / Footnote equivalent of some editor routines. ADVPTR=JMS I .;ECAPTR / ... BKPPTR=JMS I .;ECBPTR / INSCHR=JMS I .;ECICHR / INSCHR INSTCH=JMS I .;ECNCHR / INSERT /A005 GETCHR=JMS I .;ECGCHR / CURMOV & LODCHR MOVCHR=JMS I .;CRSTMV / CURMOV only. LOADCH=JMS I .;ECLOAD / LODCHR UPDSCN=JMS I .;FXSCRN / FXSCRL CHKSCN=JMS I .;CKSCRN / TSTLIM & FXSCRL PUTCHR=JMS I .;PTCHRS / Output a string of 7 bit characters. CALEDT=JMS I .;CALLAR / Linkage to editor 'CALLAR' routine. NXTCHR=JMS I .;FNXCHR, 0 / Get next char (= GETCHR /or/ ADVPTR) /A003 MAXCHR=40 / Maximum size of word (32 decimal). NLINES=11 / Number of lines within scrolling region. FLINES=24 / # of lines in footnote scrolling region/A003 BUF0LEN=226 / length of correct word buffer (150 dec.) BUF1LEN=74 / length of table of correct words / (max. of 30 words, 2 entries/word) / Equates for Footnote Processing /A002 ECSTFN=74 / Start of footnote (left angle bracket) /A002 ECNDFN=76 / End of footnote (right angle bracket) /A002 SUPBIT=1000 / Superscript bit /A002 DECIMAL MAXCOL=238 / Maximum column number is 238 decimal /A005 OCTAL IFNDEF DSUSAV < /***TEMP*** /A003 DSUSAV=57 /***TEMP*** /A003 > / end ifndef DSUSAV /A003 /--------- PAGE /------------------------------------------------------------------------/ / / NOTE: All FATAL errors, after being reported, jmp to EOF for final / cleanup. In order to catch the start-up errors, the entry point / and exit CDI are assembled to return to appropriate clean-up / code. / /------------------------------------------------------------------------/ SPELL, STRTGM / entry point to spelling checker. RDF / Get return data field. TAD CIDF0 / Make a return CID instruction. DCA SPLXIT / save for final return. /D005 CDFMYF /MAKE SURE WE'RE HERE (HURTS LT PINCH) /001 /D005 TAD (SCRNIN) /NEED ADR OF SCREEN INIT ROUTINE /001 /D005 CDFEDT /WPSC IS IN PART OF EDIT FLD /001 /D005 CLA /DCA I (SINADR) /INTO DISPATCH TABLE IN WPSC /001 CDFMNU /NEED TO ZAP LOCK WORDS /D009 TAD (OLL301) /USE ADDRESS FOR RANDOMCONSTANT DCA I (OLL301) /TO ZAP FIELD 5 LOCK WORD /D009 TAD (OLL301) /AGAIN DCA I (OLL400) /TO ZAP FIELD 6 LOCK WORD CDFMYF / Back to our field. JMS INITFN / Init footnote process /A002 JMP SCNXT2 / merge below to get to 1st posn. EOF, JMS CLRRGN / Clear scrolling region. SPLXIT, CDIEDT / Map return field. JMP I SPELL / Return to Menu (or where ever). CHKAPU, /THESE TAGS ARE TO PREVENT 'US' /001 LODAPU, /ASSEMBLY ERRORS IN WPSC /001 IFDEF OLDSPL < /A005 / / return to here to ignore.... / SCFIX,/SB JMS DISPLY / Refresh the word unreversed video. /SB 0 / Say NOT REVERSED VIDEO. CDFEDT / Compute cursor posn of last char of word. AC7777 / CURPOS currently points to next posn so backup. TAD I (CURPOS) / ... DCA I (CURSOR) / Set current cursor posn to there. / / merge here to scan to the start of the next word. / SCNEXT, CDFEDT / Re-enable ECHO while scanning to next word. AC0001 / ... DCA I (ECHFLG) / .... TAD I (SCRLCT) / Test screen lag. CDFMYF / SZA CLA / Skip if no lag. JMS UNDOLG / Update screen. > / end ifdef OLDSPL /A003 SCNXT1, AC0001 / Move to next CURSOR position. SCNXT2, NXTCHR / Get (next) character. /C003 JMP FNDUMP / If we get EOF, go dump the footnotes /A002 DCA CHAR / Save character /A002 CDFSYS / Check the HALT FLAG. /A004 TAD I HLTFLG / ... /A004 CDFMYF / .... /A004 SZA CLA / Skip if it's not set. /A004 JMP HLTERR / Halt flag set. Abort process /A004 TAD CHAR / Get character /A005 TAD (-ECPCT1 / Is is Start Control? /A005 SNA CLA / /A005 JMP CKFNRL / Yes, check if footnote ruler defn /A005 SCNXT5, TAD FNOTP / Footnotes on this page? /A002 SNA CLA / /A002 JMP SCNXT4 / No, just look for footnote start /A002 TAD CHAR / Get character /A002 TAD (-ECNWPG / Is it New Page Mark? /A002 SNA CLA / /M005 JMP FNDUMP / Yes, go dump the footnotes /A002 /D005 TAD (ECNWPG-ECPMRK / Is it Page Mark? /A002 /D005 SZA CLA / /A002 /D005 JMP SCNXT3 / No /A002 /D005 TAD APFN / Yes, are we autopaginating? /A002 /D005 SNA CLA / /A002 /D005 JMP FNDUMP / No, so page mark => dump footnotes /A002 SCNXT3, TAD WTHNFN / Are we within a footnote? /A002 SZA CLA / /A002 JMP FNCHAR / Yes, process a footnote character /A002 TAD APFN / Not in a footnote, are we autopaging? /A002 SNA CLA / /A002 JMP SCNXT4 / Nope, see if it's footnote start /A002 JMS INCRLN / Autopaging: check line count change /A002 JMP SCNXT1 / no change /A002 JMS PGFULL / Check if the page is full /A002 JMP SCNXT1 / nope /A002 / Should backup to line start and dump footnotes, but doesn't yet /A002 JMP SCNXT1 / yup /A002 / Look for footnote start SCNXT4, TAD CHAR / Get character /A002 / Should handle footnote ruler, but doesn't yet /A002 AND P177 / Isolate only the character bits /A002 TAD (-ECSTFN / Is it footnote start? /A002 SZA CLA / /A002 JMP SCNXT1 / No, go on /A002 JMP MAYBFN / Maybe footnote start /A002 INCRLN, XX /A002 / Should check line count change /A002 JMP I INCRLN /A002 PGFULL, XX /A002 / Should check if page is full /A002 JMP I PGFULL / /A002 /------ PAGE / / FNCHAR - Here when processing a footnote. We've seen the footnote start / and we're picking up the footnote characters, deleting them from / the editor buffer, and storing them in the footnote buffer. We / delete soft spaces, line wraps, and select marks, etc. since these / have to be recalculated when the footnote is re-inserted at the / end of the page. If we encounter a Start Ruler command, we abort / the process, as this is illegal (we don't know how to move the / ruler). If we find a start of dead key sequence, we loop till we / find the end, not checking anything within the sequence. / FNCHAR, TAD CHAR / Get the character /A002 AND P177 / Isolate only the character bits /A002 TAD (-ECSTOV / Is it start of dead key sequence? /A009 SNA / /A009 JMP FNDKS / Yes, go handle it /A009 TAD (ECSTOV-ECNDFN / Is it footnote end? /M009 SNA / /A002 JMP FFNEND / Maybe, go find footnote end /A002 TAD (ECNDFN-ECMDFL / Is it line/ruler modified? /A003 SNA / /A003 JMP SCNXT1 / Yes, skip over it /A003 TAD (ECMDFL-ECSTRL / Is it ruler start? /A003 SNA / /A003 JMP RLRINF / Yes, that's a no-no /A003 TAD (ECSTRL-ECSPC / Is it space, justify space, posn mark?/A003 SZA / Yes, delete all but space /A003 TAD (ECSPC-ECNWLN / Is it new line class? /A003 SZA CLA / /A003 JMP FNCHR1 / No /A003 TAD CHAR / Get original char /A003 AND (2000 / Is it wrapped line or select point? /A003 TAD (-2000 / (or justify space or posn marker?) /A003 SZA CLA / /A003 JMP FNCHR1 / No /A003 JMS DELCHR / Yes, delete it /A003 JMP SCNXT2 / Proceed /A003 FNCHR1, TAD APFN / Are we autopaginating? /A002 SZA CLA / /A002 JMP FNCAPY / Yes, process footnote char. w/AP=Yes /A002 TAD CHAR / No, just put char in footnote buffer /A002 JMS PUTFNB / /A002 JMS DELCHR / And delete it from Editor buffer /A002 JMP SCNXT2 / Proceed /A002 / Start of dead key sequence encountered in footnote: scan for the /A009 / end of it, moving characters to the footnote buffer without checking /A009 / for special characters. /A009 FNDKS1, NXTCHR / Get next character /A009 JMP WRDEOF / EOF in middle of dead key sequence? /A009 DCA CHAR / Store the character /A009 FNDKS, TAD CHAR / Get the character /A009 JMS PUTFNB / Store in footnote buffer /A009 JMS DELCHR / Delete char from edit buffer /A009 TAD CHAR / Was it end of dead key sequence? /A009 TAD (-ECNDOV / /A009 SNA CLA / /A009 JMP SCNXT2 / Yes, back to normal process /A009 JMP FNDKS1 / No, keep looking for end dead /A009 / Ruler encountered within footnote: error, as we're not smart enough /A003 / to move it correctly. /A003 RLRINF, TAD (ERRRWF / Get pointer to msg /A003 JMP DSKERR / Go print msg and wait for RETURN /A003 FNCAPY, / Should check line count incr/page full, but doesn't yet /A002 JMP SCNXT1 / Proceed /A002 / / MAYBFN - May be Footnote Start / / Here when found a single angle bracket (<). We check if it is / followed by another (<) and is preceded by a superscripted / character. If so, then it defines start of a footnote. / MAYBFN, AC0001 / Move to next cursor position /A002 NXTCHR / Get next character /C003 JMP FNDUMP / EOF, dump footnotes /A002 AND P177 / Isolate character bits only /A002 TAD (-ECSTFN / Is it footnote start? /A002 SZA CLA / /A002 JMP SCNXT2 / No /A002 BKPPTR / Yes, backup before footnote start /A002 JMP WRDEOF / Wierd EOF /A002 /D006 BKPPTR / Now look at char before footnote /A002 /D006 JMP FFNST1 / File must start with '<<' /A002 /D006 DCA CHAR / Save character /A002 /D006 TAD CHAR / Get character /A002 /D006 AND (SUPBIT / Isolate superscript bit /A002 /D006 TAD (-SUPBIT / Is it superscripted? /A002 /D006 SZA CLA / /A002 /D006 JMP FFNST2 / No /A002 /D005 TAD CHAR / Get the character /A002 /D005 AND P177 / Isolate character bits only /A002 /D005 X="0&177 /D005 TAD (-X / See if numeric /A002 /D005 SPA / /A002 /D005 JMP FFNST2 / No /A002 /D005 TAD ("0-"9 / /A002 /D005 SMA SZA CLA / /A002 /D005 JMP FFNST2 / No /A002 / ?Should we check footnote within footnote? if so, change SCNXT4 /A002 MAYBF1, /D006 ADVPTR / Yes, a real footnote, point at '<<' /A002 /D006 JMP WRDEOF / Wierd EOF /A002 / Should assign a footnote number, if we're autonumbering-doesn't yet /A002 FNSTRT, JMS DELCHR / Delete first '<' from Editor buffer /A002 TAD (ECTMRK / And insert marker to return to /A002 INSCHR / /A002 JMS DELCHR / Delete second '<' /A002 ISZ WTHNFN / Set Within Footnote /A002 / Should insert CR, Footnote Ruler in Editor Buffer-doesn't /A002 TAD (ECAPTR / Set so NXTCHR does ADVPTR /A003 DCA FNXCHR / /A003 TAD APFN / Autopaginating? /A002 SZA CLA / /A002 JMP FNSTR1 / Yes /A002 TAD FNOTP / Footnotes on this Page? /A002 SZA CLA / /A002 JMP FNSTR2 / Yes, skip insertion of short-rule /A002 TAD FNDLAD / No, get addr. of footnote delimiter /A002 DCA X1 / into auto-index register /A002 FNSTR4, TAD I X1 / Get a character of delimiter /A002 SNA / End of delimiter string? /A002 JMP FNSTR2 / Yes /A002 JMS PUTFNB / No, put character in footnote buffer /A002 JMP FNSTR4 / Loop /A002 /Should see if room on page for short-rule & first footnote line-doesn't/A002 / if not-do footnote crosses page w/AP=yes, if so, start count of foot /A002 / note lines this page. /A002 FNSTR1, FNSTR2, ISZ FNOTP / Set Footnotes on this Page. /A002 JMP SCNXT2 / Proceed /A002 /D006FFNST2, ADVPTR / Forward over non-superscript char /A002 /D006 JMP WRDEOF / Wierd EOF /A002 /D006FFNST1, ADVPTR / Forward over fake footnote start /A002 /D006 JMP WRDEOF / Wierd EOF /A002 /D006 JMP SCNXT1 / Go get next character /A002 /------ PAGE / / FFNEND - Found Footnote End / / Here when we find the closing (>>) to end the footnote. We terminate / the footnote in the footnote buffer with a New Line. Then we fix / the NXTCHR routine so that it does GETCHR's instead of ADVPTR's (so / the non-footnote text scrolls by on the screen. / FFNEND, ADVPTR / Get next character /A002 JMP FNEND / EOF, treat as footnote end /A002 DCA CHAR / Store char /A003 TAD CHAR / Get char /A003 AND P177 / Isolate character bits only /A002 TAD (-ECNDFN / Is it footnote end? /A002 SZA CLA / /A002 JMP SCNXT2 / No /A002 JMS DELCHR / Yes, delete the second char /A002 FNEND, BKPPTR / Backup CURPTR /A002 JMP WRDEOF / Wierd EOF??? /A002 JMS DELCHR / Delete the first char /A002 FNEND1, BKPPTR / Backup CURPTR /A002 JMP WRDEOF / Wierd EOF??? /A002 TAD (-ECTMRK / This the marker we left in? /A002 SZA CLA / /A002 JMP FNEND1 / No /A002 JMS DELCHR / Yup, delete it /A002 DCA WTHNFN / Clear Within Footnote flag /A002 TAD (ECGCHR / Set so NXTCHR does GETCHR /A003 DCA FNXCHR / /A003 TAD APFN / Autopaginating? /A002 SZA CLA / /A002 JMP APFNND / Yes, handle footnote end /A002 TAD (ECNWLN / Put New Line in buffer /A002 JMS PUTFNB / to terminate this footnote /A002 / Should backup to mark, delete hard rtn & footnote ruler-doesn't /A002 JMP SCNXT2 / Proceed /A002 APFNND, / /A002 / Should put new line in bfr, chk for field 5 full, chk for more than /A002 / one page worth of footnotes, etc.- doesn't /A002 TAD (ECNWLN / Put New Line in buffer /A002 JMS PUTFNB / to terminate this footnote /A002 JMP SCNXT1 / Proceed /A002 WRDEOF, TAD (ERRUEF / Unexpected End of File /A003 JMP DSKERR / Give the message and terminate /A003 / / DELCHR - Delete character from editor buffer / / Deletes current character from editor buffer, and sets line / modified flag. / DELCHR, XX / /A002 CLA / Clear out the trash /A002 CDFEDT / Change to Editor Field /A002 TAD I (CURPTR / Pickup CURPTR /A002 DCA SCURPT / Store it locally /A002 CDFBUF / Change to Editor buffer field /A002 DCA I SCURPT / Delete the footnote character /A002 CDFMYF / Back to our field /A002 SLNMOD / Set line modified /A002 JMP I DELCHR / Return /A002 / / FNDUMP - Dump the footnote at end of page (or end of document). / / Here when we hit New Page mark or End of File. We store an EOF in / the footnote buffer. If footnote text has spilled over to / the scratch area on the disk, we write out the last block and read / in the first block, in preparation for inserting footnotes into / the editor buffer. / / If a footnote ruler was defined in a Footnote Control Block, we / insert the ruler, followed by the footnote text. After all the / text is inserted, we restore the ruler which was in effect prior / to insertion of footnotes. / FNDUMP, TAD FNOTP / Footnotes on this page? /A002 SNA CLA / /A002 JMP NOFN / Nope /A002 JMS PUTFNB / Yes, store EOF in footnote buffer /A002 TAD FNODSK / Footnotes overflow onto disk? /A003 SNA CLA / /A003 JMP FNDMP5 / No /A003 JMS WRTFNB / Yes, write out last buffer /A003 JMS RDFRST / And read in first /A003 FNDMP5, TAD WTHNFN / Within footnote? /A002 SZA CLA / /A002 JMP NDMSNG / Yes, end of footnote missing /A002 FNDMP0, BKPPTR / Backup to check previous character /A005 JMP WRDEOF / Wierd EOF /A005 DCA CHAR / Save temporarily /A005 ADVPTR / Back where we were /A005 NOP / Have to ignore EOF here /A005 CLA / Clear out the garbage /A005 TAD CHAR / Get previous character /A005 AND P177 / Just the character bits /A005 TAD (-ECNWLN / Is it new line of some sort? /A005 SZA CLA / /A005 TAD (ECNWLN / No, so insert new line before footnts /A005 SZA / Don't insert a null /A005 INSCHR / In case no CR at last line /A005 JMS INSRL / Now insert footnote ruler /A002 FNRLBF / Which is stored in FNRLBF /A002 FNDMP1, JMS GETFNB / Get character from footnote buffer /A002 SNA / Footnote EOF? /A002 JMP FNDMP2 / Yup /A002 INSCHR / No, insert it in Editor buffer /A002 CDFSYS / Check the HALT FLAG. /A004 TAD I HLTFLG / ... /A004 CDFMYF / .... /A004 SNA CLA / Skip if it's set. /A004 JMP FNDMP1 / Loop back /A002 HLTERR, TAD (ERRHLT / Print message and abort /A004 JMP DSKERR / /A004 FNDMP2, TAD APFN / Autopaginating? /A002 SNA CLA / /A002 JMP FNDMP4 / No /A002 AC7777 / Yes, decr. # pages worth of footnotes /A002 TAD PGESFN / /A002 SPA / More footnotes in buffer? /A002 JMP FNDMP3 / No /A002 DCA PGESFN / Yes, store updated count /A002 / Should reset count of footnote lines to count for next page-doesn't /A002 / and if at Eof, should dump rest of footnotes /A002 JMP FNDMPX / Done /A002 FNDMP4, JMS INSRL / Now restore old current ruler /A005 CURLBF / Which is stored in CURLBF /A005 ADVPTR / Move over (New) Page Mark /A002 NOP / Eof is caught below /A002 FNDMP3, CLA / Set no more Footnotes on this Page /A002 DCA FNOTP / /A002 NOFN, JMS INITPG / Init for next page processing /A002 FNDMPX, GETCHR / Are we at EOF? /A002 JMP EOF / Yes, finish up /A002 CLA / clear out the junk /A007 JMP SCNXT2 / No, proceed /A002 NDMSNG, TAD (ERRFEM / Footnote end missing /A003 / Should print message, then allow continue-doesn't /A002 JMP DSKERR / Give the message and terminate /A003 /----------- PAGE IFDEF OLDSPL < /SB WRDOK, CDFSYS / Check the HALT FLAG. TAD I HLTFLG / ... CDFMYF / .... SNA CLA / Skip if it's set. JMP SCNEXT / Halt flag not set. Continue scanning. ISZ HALTFG / Say that we GOLD:HALTed. AC7777 / Say that no word is highlighted. DCA VIDEO / ... JMP WRDERR / Merge to user menu. NTFND1, AC7777 / Bump size back down. Highlight the word TAD WRDSIZ / without the terminating period. DCA WRDSIZ / ... /SB JMS SNDWD1 / Send incorrectly spelt word w/o the period. NTFND2, TAD HYPHEN / Is word hyphenated? SMA SZA CLA / Skip if part of hyphenated word in error. JMP NTFND4 / Jmp if only done 1st pass on hyphenated word. CDFEDT / Now do a 'screen check' for 158 col mode. TAD I (CURSOR) / If word terminates in 2nd half TAD (-WIDTH) / then be sure that 2nd screen gets displayed. SMA CLA / Skip if word doesn't end in 2nd half. JMP NTFND3 / JMP if word ends in right-half screen. TAD SCURSR / Get start of word. Make sure that start-of- DCA I (CURSOR) / word half is mapped. NTFND3, CDFMYF / Back to our field. CHKSCN / Make sure right screen is displayed. TAD SCURSR / Restore CURSOR to point to start of word. CDFEDT / ... DCA I (CURSOR) / .... CDFMYF / back to our field. DCA HALTFG / Say that NOT stopped due to GOLD:HALT. WRDERR, JMP EOF /SBERRGCOR / set up to display corrections.. / / return to here to continue..... / SCCONT, TAD VIDEO / Did we edit the line? SZA CLA / Skip if yes. Editting reset the restart point. JMP SCFIX / Didn't edit. Unhighlight word & continue. /SB JMS ECPSCN / Position cursor to start of restart word. DCA NEWLIN / Say "still on same old line". JMP SCNXT2 / Rescan old word. / to rejustified posn & we're done. > /END IFDEF OLDSPL /SB / / CKFNRL - Check if control block is a footnote ruler definition / / Come here when we find a start control block. We check if the / control block begins with the phrase "FOOTNOTE" and / if so, start looking for ruler setting commands like "L=1", / "R=65", "T=20", "<=44" etc. They may be in any order, as the / Editor doesn't care, but they must end with New Line, and must / not have embedded spaces. They may be upper or lower case. / / Edit 010 now uses new logic to copy the forward pointing ruler / from any ruler imbedded in the control block. If there is no / ruler in the control block, the existing format ruler (if any) / is shut off. / CKFNRL, TAD (FNRTXT-1 / Get addr of key phrase /A005 DCA CKFRT1 / To temp storage /A005 CKFNR1, /M010 /d010 TAD CHAR / /A005 /d010 TAD (-ECPCT2 / Is it end of control block? /A005 /d010 SNA CLA / /A005 /d010 JMP SCNXT5 / Yeah, back where we came from /A005 ISZ CKFRT1 / Bump to next character /A005 TAD I CKFRT1 / Get character of Footnote ruler phrase/A005 SNA CLA / End of string? /M010 JMP CKFNR2 / Yes /A005 AC0001 / ... /A005 NXTCHR / Get next character /A005 JMP FNDUMP / If EOF, dump the footnotes /A005 DCA CHAR / Store character /A005 TAD I CKFRT1 / Get back char. of Footnote ruler phrase/M010 TAD CHAR / Add the text character /A005 AND P177 / Just the character bits /A005 SNA / Match? /A005 JMP CKFNR1 / Yes /A005 TAD (-40 / Try lower case version /A005 SNA CLA / Match? /A005 JMP CKFNR1 / Yes, keep going /A005 JMP SCNXT5 / No, go back where we came from /A005 CKFRT1, 0 / -> into footnote ruler phrase /A005 FNRCHR, 0 / Temp storage for footnote ruler char /A005 / Found Footnote Ruler Control Block /A005 / Start looking for ruler(s). /M010 CKFNR2, DCA FNRFLG / Shut off footnote ruler /A010 /d010 SKP / Already got next char /A005 CKFNR8, ADVPTR / Peek ahead /A010 NOP / Handle EOF later /A010 TAD (-ECSTRL / Are we at a ruler? /A010 SNA CLA / Skip if NOT a ruler /A010 JMP CKFINR / Go process ruler /A010 CKFNR9, BKPPTR / Back to where we started /A010 NOP / Don't care about EOF /A010 AC0001 / Get next char /A005 NXTCHR / ... /A005 JMP FNDUMP / If EOF, go dump the footnotes /A005 DCA CHAR / Store it /M010 TAD CHAR / Get it back /A005 TAD (-ECPCT2 / Is it End Control Block? /A005 SNA CLA / /A005 JMP SCNXT1 / Yes, back to main line /M010 JMP CKFNR8 / Look at next char in control block /A010 CKFINR, / Read the ruler until we find the /A010 / forward pointing portion /A010 TAD (FNRLBF+2 / Get adr of footnote ruler buffer /A005 DCA FNRBFP / Store in pointer to buffer /A005 DCA CKFRT1 / use to count how far forward we go /A010 CKFIN1, ISZ CKFRT1 / INCREMENT COUNT /A010 SKP / NORMAL PATH /A010 JMP FCBERR / RULER MUCH TOO LONG! /A010 ADVPTR / Get next character /A010 JMP WRDEOF / Any file that ends in a ruler is WIERD/A010 TAD (-ECMDRL / Is it the mid-ruler character? /A010 SZA CLA / Skip if it is /A010 JMP CKFIN1 / Else not there yet - get next char /A010 CKFCPR, / Now copy each char into the format /A010 / ruler buffer until end of ruler | ERR/A010 ISZ CKFRT1 / INCREMENT COUNT /A010 SKP / NORMAL PATH /A010 JMP FCBERR / RULER MUCH TOO LONG! /A010 ADVPTR / Get next character /A010 JMP WRDEOF / Any file that ends in a ruler is WIERD/A010 TAD (-ECNDRL / Have we reached the end? /A010 SNA / Skip if NOT end /A010 JMP FNREND / Else end of ruler - go finish up /A010 TAD (ECNDRL / Get character back /A010 JMS PTFNR / & copy it to footnote ruler buffer /A010 JMP CKFCPR / & loop back for next character /A010 /d010 TAD (-FNRTSZ / Get counter for ruler char table /A005 /d010 DCA CKFRT1 / Store in a temp /A005 /d010 TAD (FNRTBL-1 / Get adr of ruler char table /A005 /d010 DCA X1 / Store in auto index reg /A005 /d010 TAD CHAR / Get char back /A005 /d010 AND P177 / Just the char bits /A005 /d010 TAD I X1 / Is it "."? /A005 /d010 SNA / /A005 /d010 JMP CKFNR3 / Yes, go handle it /A005 /d010 ISZ X1 / No, skip equiv. char. /A005 /d010 TAD I X1 / Is it ">"? /A005 /d010 SNA / /A005 /d010 JMP CKFNR3 / Yes, go handle it /A005 /d010 CKFNR4, ISZ X1 / Skip equiv. char. /A005 /d010 TAD I X1 / Match this char? /A005 /d010 SNA / /A005 /d010 JMP CKFNR3 / Yes, go handle it /A005 /d010 TAD (-40 / No, match lower case version of it? /A005 /d010 SNA / /A005 /d010 JMP CKFNR3 / Yes, go handle it /A005 /d010 TAD (40 / No, back to uppercase check /A005 /d010 ISZ CKFRT1 / End of table? /A005 /d010 JMP CKFNR4 / No, loop to next /A005 /d010 CKFNR5, TAD (ERRIRC / Char not legal Footnote Ruler Operator/A005 /d010 JMP DSKERR / Give message and terminate /A005 FCBERR, TAD (ERRFCB / Footnote Control Block error /A005 JMP DSKERR / /A005 / Found character in table of legal ruler characters, get the /A005 / equivalent internal character, then pick up the column number. /A005 /d010 CKFNR3, TAD I X1 / Get equivalent character /A005 /d010 DCA FNRCHR / Store for later /A005 /d010 DCA FNRCOL / Init column number to zero /A005 /d010 AC0001 / Get next char /A005 /d010 NXTCHR / /A005 /d010 JMP FNDUMP / If EOF, go dump the footnotes /A005 /d010 DCA CHAR / Store it /A005 /d010 TAD CHAR / Get it back /A005 /d010 AND P177 / Just the char bits /A005 /d010 X="=&177 /d010 TAD (-X / Is it equals sign? /A005 /d010 SZA CLA / /A005 /d010 JMP CKFNR5 / No, error /A005 /d010 CKFNR6, JMS CVTD / Yes, convert column number to decimal /A005 /d010 JMP CKFNR7 / End of string /A005 /d010 JMP CKFNR6 / Digit, keep checking /A005 /d010 CKFNR7, TAD FNRCOL / Get the column number /A005 /d010 RTR / Isolate top 4 bits of col /A005 /d010 RTR / ... /A005 /d010 AND (17 / /A005 /d010 SZA / Don't store first digit of 0 /A005 /d010 TAD (60 / Make it ascii /A005 /d010 SZA / Don't store first digit of 0 /A005 /d010 JMS PTFNR / Store it in the ruler buffer /A005 /d010 TAD FNRCOL / Now the low 4 bits of col /A005 /d010 AND (17 / ... /A005 /d010 TAD (60 / ... /A005 /d010 JMS PTFNR / Store it in ruler buffer /A005 /d010 TAD FNRCHR / Get the footnote ruler char /A005 /d010 JMS PTFNR / Store it in ruler buffer /A005 /d010 JMP CKFNR8 / Go check for more ruler chars /A005 FNREND, TAD (ECNDRL / Store end ruler flag in buffer /A005 JMS PTFNR / /A005 AC7777 / Set footnote ruler encountered /A005 DCA FNRFLG / ... /A005 TAD CKFRT1 / GET COUNT OF HOW FAR WE WANDERED /A010 CIA / NEGATE /A010 DCA CKFRT1 / SAVE IT FOR LOOP COUNTER /A010 FNREN1, BKPPTR / Back to where we were /A010 NOP / Ignore EOF here /A010 ISZ CKFRT1 / SKIP IF WE ARE BACK /A010 JMP FNREN1 / /A010 JMP CKFNR9 /A010 /------ /A005 PAGE / / PTFNR - Put character to footnote ruler /A005 / PTFNR, XX / /A005 DCA I FNRBFP / Store character in ruler buffer /A005 ISZ FNRBFP / Increment pointer /A005 CLL / /A005 TAD FNRBFP / Past end of buffer? /A005 TAD (-FNRLBE / /A005 SZL CLA / /A005 JMP FCBERR / Give Error and abort /A005 JMP I PTFNR / Return /A005 FNRBFP, 0 / -> into footnote ruler buffer /A005 / / CVTD - Convert ASCII column number to decimal /A005 / JMS CVTD /A005 / JMP NOTDIG / End of string /A005 / JMP .-2 / Char was a digit, loop /A005 / /A005 / Value stored in FNRCOL /A005 / /d010 CVTD, XX / /A005 /d010 AC0001 / Get next char /A005 /d010 NXTCHR / /A005 /d010 JMP FNDUMP / If EOF, go dump the footnotes /A005 /d010 DCA CHAR / Store it /A005 /d010 TAD CHAR / Get the char. /A005 /d010 AND P177 / Isolate character bits /A005 /d010 X="9&177 / /A005 /d010 TAD (-X / Is it a decimal digit? /A005 /d010 SMA SZA / /A005 /d010 JMP CVTD2 / Nope /A005 /d010 TAD ("9-"0 / Keep checking /A005 /d010 SPA / /A005 /d010 JMP CVTD2 / Not a digit /A005 /d010 DCA T1 / Ok, store in a temp /A005 /d010 TAD FNRCOL / Get footnote ruler column so far /A005 /d010 CLL RTL / x 4 /A005 /d010 TAD FNRCOL / x 5 /A005 /d010 RAL / x 10 /A005 /d010 TAD T1 / + digit /A005 /d010 TAD (-MAXCOL / Is it greater than 238 decimal? /A005 /d010 SMA / /A005 /d010 JMP CKFNR5 / Yes, error /A005 /d010 TAD (MAXCOL / Get column number back /A005 /d010 DCA FNRCOL / Store it away /A005 /d010 ISZ CVTD / Return to call +2 /A005 /d010 CVTD1, JMP I CVTD / Return /A005 /d010 CVTD2, CLA / /A005 /d010 TAD CHAR / /A005 /d010 AND P177 / /A005 /d010 TAD (-ECNWLN / Is it New Line? /A005 /d010 SZA CLA / /A005 /d010 JMP CKFNR5 / No, error /A005 /d010 JMP CVTD1 / Yes, return to call+1 /A005 /d010 /d010 FNRCOL, 0 / Holds footnote ruler column number /A005 / /A002 / INSRL - Insert Ruler into Editor Buffer /A002 / /A005 / Inserts ruler into editor buffer, backs over it, then CURMOV's /A005 / over it so old current ruler is inserted into ruler. Then backs /A005 / over it and saves old current ruler in CURLBF so it can be /A005 / reinserted after footnotes have been dumped. /A005 / / JMS INSRL /A002 / BUFADR / address of buffer containing ruler /A005 / INSRL, XX / /A002 TAD FNRFLG / Was a footnote ruler encountered? /A005 SNA CLA / /A005 JMP INSRX / No, so just return /A005 TAD I INSRL / Get pointer to ruler /A005 DCA FNRBFP / Store in a temp /A005 AC7777 / Backup pointer by one /A005 GETCHR / /A005 JMP WRDEOF / /A005 CLA / Clear the character /A005 CDFEDT / To the editor field /A005 TAD I (CURPTR / Get CURPTR /A005 CDFMYF / Back to my field /A005 DCA SCURPT / Save it locally /A005 ADVPTR / Advance one char /A005 NOP / Have to ignore EOF here /A005 CLA / Clear out garbage /A005 INSR1, TAD I FNRBFP / Get a char of the ruler /A005 INSTCH / Insert the char into Editor Buffer /A005 ADVPTR / Step over it /A005 NOP / Have to ignore EOF here /A005 CLA / Clear out the garbage /A005 TAD I FNRBFP / Get the char back /A005 ISZ FNRBFP / Bump the pointer /A005 TAD (-ECNDRL / Is it end of ruler? /A005 SZA CLA / /A005 JMP INSR1 / No, continue /A005 INSR2, CDFEDT / To editor field /A005 TAD SCURPT / Get saved CURPTR /A005 DCA I (CURPTR / Restore it /A005 CDFMYF / Back home /A005 AC0001 / Ok, now CURMOV past the ruler /A005 GETCHR / /A005 NOP / Have to ignore EOF here /A005 INSR3, BKPPTR / Now backup over ruler again /A005 JMP WRDEOF / Should never happen /A005 TAD (-ECSTRL / Is it start of ruler? /A005 SZA CLA / /A005 JMP INSR3 / No, keep backing up /A005 TAD (CURLBF+2 / Yes, get pointer to save bfr for curul/A005 DCA FNRBFP / Save in a temp /A005 INSR4, ADVPTR / Step over ruler start /A005 JMP WRDEOF / Should never happen /A005 TAD (-ECMDRL / Is it ruler middle? /A005 SNA / /A005 JMP INSR5 / Yes, end of current ruler /A005 TAD (ECMDRL / Restore the char /A005 DCA I FNRBFP / Store in current ruler save buffer /A005 ISZ FNRBFP / Bump the pointer /A005 JMP INSR4 / Loop back /A005 INSR5, TAD (ECNDRL / Store End Ruler in the buffer /A005 DCA I FNRBFP / /A005 INSR6, ADVPTR / Look for ruler end /A005 JMP WRDEOF / Should never happen /A005 TAD (-ECNDRL / Is it ruler end? /A005 SZA CLA / /A005 JMP INSR6 / No /A005 ADVPTR / Yes, skip over it /A005 NOP / Have to ignore EOF here /A005 CLA / Clear out the garbage /A005 TAD (ECRMFL / Insert Ruler Modified flag /A005 INSCHR / Into editor buffer /A005 INSRX, ISZ INSRL / Bump return address /A005 JMP I INSRL / Return /A002 /------ PAGE / / FNRTBL - Table of legal footnote ruler settings and equivalent internal / characters used by the editor. / / Format of table: / 1st: -"x; "y&177 / x is setting, y is equiv. internal character / rest: "x-"z; "w&177 / z is setting, w is equiv. internal char. / etc. / end: 0 / (Note: "." and ">" must be first two, since after first two, code checks / for upper/lower case value of setting. / X=".&177 / /A005 FNRTBL, -X; "A&177 / Decimal tab /A005 ".-">; "B&177 / Right-just tab /A005 FNRTB1, ">-"T; "C&177 / Normal tab /A005 "T-"L; "D&177 / Left margin, single spaced /A005 "L-"R; "E&177 / Right margin, ragged /A005 "R-"D; "F&177 / Left margin, double spaced /A005 "D-"J; "G&177 / Right margin, justified /A005 "J-"W; "H&177 / Word wrap indent /A005 "W-"P; "I&177 / Paragraph indent /A005 "P-"C; "J&177 / Centering Point /A005 "C-"N; "K&177 / Left margin, space and a half /A005 "N-"H; "L&177 / Hyphenation zone /A005 "H-"F; "M&177 / Left Margin, half line spaced /A005 FNRTBE, 0 / End of table /A005 FNRTSZ=FNRTBE-FNRTB1 / Size of alpha portion of table /A005 / / FNRTXT - Text which marks a control block as a footnote control block. / Must match this (upper/lower case unimportant) or else the / control block is ignored. / FNRTXT, -"F; -"O; -"O; -"T; -"N; -"O; -"T; -"E /C008 -ECNWLN /C008 0 / End of table /A005 / / Footnote Buffer List /A002 / Each entry is 3 words: /A002 / Word 1 = CDF to buffer field /A002 / Word 2 = -(size of buffer in words) /A002 / Word 3 = start addr of buffer (page boundary) /A002 / 0 Terminates list /A002 / Last entry in list is address of footnote I/O buffer. If no room in /A003 / memory for all footnote text, this buffer is used over and over to /A003 / read/write excess footnote text on the utility diskette. /A003 / ** Hopefully temp., first word of fld 5 was being zapped, use 200 ** /A002 FNBFL, CDFTXT / = CDF to buffer field /A002 -40+5^200 / = -size of buffer (in words) /A002 200 / = start addr of buffer (page boundary) /A002 FNIOBP, CDFMYF /*** Must be LAST entry in list *** /A003 -400 / = 1 block buffer /A003 FNIOBF / = addr of footnote I/O buffer /A003 0 / List terminator /A002 / / Short Ruled line for footnote delimiter /A002 / SHRTRL, "_&177; "_&177; "_&177; "_&177; "_&177; "_&177; ECNWLN; ECNWLN /A002 0 / List terminator /A002 / / Init Footnote Process /A002 / INITFN, XX / /A002 DCA WTHNFN / Not within a footnote /A002 DCA APFN / Assume not autopaginating /A002 DCA FNRLSN / Footnote ruler not seen yet /A002 DCA PGESFN / 0 pages worth of footnotes /A002 JMS INITBL / Init footnote buffer list ptrs /A002 JMP I INITFN / Return /A002 / / Init Footnote Buffer List Pointers and Next Char Routine Pointer /A002 / INITBL, XX / /A002 TAD (FNBFL-1 / Get pointer to footnote buffer list /A002 DCA X1 / into auto-index reg. /A002 TAD I X1 / Get CDF to buffer field /A002 DCA FNPCDF / Store in buffer fill (put) routine /A002 TAD FNPCDF / /A002 DCA FNGCDF / and buffer empty (get) routine /A002 TAD I X1 / Get minus size of buffer /A002 DCA FNBPCT / Store as count of room in buffer (put)/A002 TAD FNBPCT / /A002 DCA FNBGCT / (and get) /A002 TAD I X1 / Get start addr of buffer /A002 DCA FNBPPT / Store in footnote buffer put pointer /A002 TAD FNBPPT / /A002 DCA FNBGPT / (and get pointer) /A002 TAD X1 / Store addr-1 of next buffer list entry/A002 DCA FNBPLP / in buffer list put pointer /A002 TAD FNBPLP / /A002 DCA FNBGLP / (and get pointer) /A002 TAD (SHRTRL-1 / Store address of shortruled line /A002 DCA FNDLAD / as address of footnote delimiter /A002 TAD (ECGCHR / Init next char routine to do GETCHR /A003 DCA FNXCHR / /A003 JMP I INITBL / Return /A002 / / Init for next page processing /A002 / INITPG, XX / /A002 TAD (ECGCHR / Init next char routine to do GETCHR /A003 DCA FNXCHR / /A003 TAD APFN / Autopaginating? /A002 SNA CLA / /A002 JMS INITBL / No, init footnote buffer list ptrs /A002 INITPX, JMP I INITPG / Return /A002 CRSTMV, XX / Routine to do a CURMOV only. GETCHR / Get & LOAD char. NOP / Error will be handled later. CLA / Don't return the char. JMP I CRSTMV / Return w/ clean AC. /------ PAGE / PUTFNB - Put Character in Footnote Buffer /A002 / /A002 / JMS PUTFNB /A002 / /A002 / (If no more room for footnotes, generates error and terminates) /A002 / /A002 PUTFNB, XX / /A002 FNPCDF, XX / CDF to footnote buffer field /A002 DCA I FNBPPT / Store the character /A002 CDFMYF / CDF back home /A002 ISZ FNBPCT / Bump count of room in buffer /A002 JMP PUTFN1 / Still some space left /A002 / Here when a footnote buffer fills, get next entry in list of buffers /A002 TAD FNBPLP / Get addr-1 of next buffer list entry /A002 PUTFN0, DCA X1 / Store in index reg. /A002 TAD I X1 / Get CDF to buffer field /A002 SNA / End of buffer list? /A002 JMP PTFNBK / Yes, footnotes are too big /A002 DCA FNPCDF / Store CDF in line /A002 TAD I X1 / Get minus size of buffer /A002 DCA FNBPCT / Store as put counter /A002 TAD I X1 / Get addr of buffer /A002 DCA FNBPPT / Store as buffer put pointer /A002 TAD X1 / Store addr-1 of next buffer put entry /A002 DCA FNBPLP / in footnote buffer list pointer /A002 SKP / /A002 PUTFN1, ISZ FNBPPT / INC put ptr (won't skip: count didn't)/A002 JMP I PUTFNB / Return /A002 / Footnote buffer filled, and no more entries in buffer list /A002 PTFNBK, TAD FNODSK / Any FootNotes On DiSK? /A003 SZA CLA / /A003 JMP PTFNB1 / Yup, already initialized /A003 TAD (-DSUSAV-1 / No, get minus size of area on disk /A003 DCA FNWSPC / Store as footnote WRITE space avail. /A003 TAD (DLCUTB / Get address of first block /A003 DCA WTFNBK / Store it in call to write routine /A003 ISZ FNODSK / Say there are footnotes on disk /A003 JMP PTFNB2 / Proceed /A003 PTFNB1, ISZ FNWSPC / Any WRITE space left on disk? /A003 JMP PTFNB2 / Yes, go write the buffer out /A003 FSERR, TAD (ERRFSE / No, Footnote Storage Exceeded /A003 JMP DSKERR / Issue the msg and terminate /A003 PTFNB2, JMS WRTFNB / Write footnote bfr to CUT/PASTE blocks/A002 TAD (FNIOBP-1 / Get -> footnote I/O buffer list entry /A002 JMP PUTFN0 / Go continue /A002 / / Get Character from Footnote Buffer /A002 / /A002 / JMS GETFNB /A002 / /A002 / GETFNB, XX / /A002 FNGCDF, XX / CDF to footnote buffer field /A002 TAD I FNBGPT / Get the character /A002 CDFMYF / CDF back home /A002 ISZ FNBGCT / Bump count of chars taken from buffer /A002 JMP GETFN1 / Still some left /A002 / Here when a footnote buffer empties, get next entry in list of buffers/A002 DCA GTMP / Save the character /A002 TAD FNBGLP / Get addr-1 of next buffer list entry /A002 GETFN0, DCA X1 / Store in index reg. /A002 TAD I X1 / Get CDF to buffer field /A002 SNA / End of buffer list? /A002 JMP GTFNBK / Yes, footnotes spill onto disk /A002 DCA FNGCDF / Store CDF in line /A002 TAD I X1 / Get minus size of buffer /A002 DCA FNBGCT / Store as get counter /A002 TAD I X1 / Get addr of buffer /A002 DCA FNBGPT / Store as buffer get pointer /A002 TAD X1 / Store addr-1 of next buffer list entry/A002 DCA FNBGLP / in footnote buffer get list pointer /A002 TAD GTMP / Get character back /A002 SKP / /A002 GETFN1, ISZ FNBGPT / INC get ptr (won't skip: count didn't)/A002 JMP I GETFNB / Return /A002 / Footnote bfr emptied: no more entries in buffer list, get disk block /A003 GTFNBK, ISZ FNRSPC / Any more footnote text on disk? /A003 JMP GTFNB2 / Yes, go read the buffer in /A003 FRERR, /A003 / Should never happen...Physical EOF before footnote EOF /A003 TAD (ERRFSE / No, Footnote Storage Exceeded /A003 JMP DSKERR / Issue the msg and terminate /A003 GTFNB2, JMS RDFNB / Read to footnt bfr frm CUT/PASTE blks /A002 TAD (FNIOBP-1 / Get -> footnote I/O buffer list entry /A002 JMP GETFN0 / Go continue /A002 / / Read first block of footnotes stored on disk /A003 / RDFRST, XX / /A003 TAD (-DSUSAV-1 / Get minus size of area on disk /A003 DCA FNRSPC / Store as footnote read space avail. /A003 TAD (DLCUTB / Get address of first block /A003 DCA RDFNBK / Store it in call to read routine /A003 JMS RDFNB / Read the first block /A003 JMP I RDFRST / Return /A003 GTMP, 0 / Temp character storage /A002 / Write footnote buffer to CUT/PASTE blocks /A003 WRTFNB, XX / /A003 CIFMNU / Menu field /A003 JMS I (FILLIO / Write out the footnote I/O buffer /A003 RXEWT+2000 / Write function /A003 CDFMYF / Buffer field /A003 FNIOBF / Buffer address /A003 -1 / 1 block. /A003 WTFNBK, 0 / block # to write to /A003 JMP FNWERR / Footnote write error /A003 ISZ WTFNBK / Bump block # for next write /A003 NOP / (just in case) /A003 JMP I WRTFNB / Return /A003 FNWERR, TAD (ERRFNW / Error writing footnote text to disk /A003 JMP DSKERR / Give msg and terminate /A003 / Read footnote buffer from CUT/PASTE blocks /A003 RDFNB, XX / /A003 CIFMNU / Menu field /A003 JMS I (FILLIO / Read in the footnote I/O buffer /A003 RXERD+4000 / Read function /A003 CDFMYF / Buffer field /A003 FNIOBF / Buffer address /A003 -1 / 1 block. /A003 RDFNBK, 0 / block # to read from /A003 JMP FNRERR / Footnote read error /A003 ISZ RDFNBK / Bump block # for next read /A003 NOP / (just in case) /A003 JMP I RDFNB / Return /A003 FNRERR, TAD (ERRFNR / Error reading footnote text from disk /A003 JMP DSKERR / Give msg and terminate /A003 /------ /A002 PAGE /---------- / / / Jms Calioa / **** / arg1 (text string) / **** / arg2 / **** / arg3 / /---------- CALIOA, XX TAD I CALIOA / pick up the text string address DCA CALIO1 / ... ISZ CALIOA / bump to next location TAD I CALIOA / pick up next arg DCA CALIO2 / ... ISZ CALIOA / bump to next location TAD I CALIOA / pick up next arg DCA CALIO3 / ... ISZ CALIOA / bump for return RDF / Get field of caller. TAD CIDF0 / Make return CIF CDF. DCA CALIO4 / save for the return. CDFMYF / Map our field. / CIFMNU JMS I IOACAL 0 CALIO1, .-. CALIO2, .-. CALIO3, .-. CALIO4, XX / return CDI JMP I CALIOA / return to caller / / IPTCHR - Accept a character from the keyboard /A003 / Used to read a RETURN after error messages IPTCHR, XX / /A003 JMP IPTCH2 / /A003 IPTCH1, CIFSYS / /A003 JWAIT / /A003 IPTCH2, CIFSYS / /A003 XLTIN / /A003 JMP IPTCH1 / nothing /A003 JMP I IPTCHR / Return to our field with char in AC /A003 IFDEF OLDSPL < /SB TSTLAG, XX / Routine to see if still on line w/ word on it. CDFEDT / See if any current lag. TAD I (SCRLCT) / ... CDFMYF / also see if any TAD ELINCT / lag from line word is on. SZA CLA / Skip if yes. Take 1st return. ISZ TSTLAG / Not on same line. take "end-of-UNIT" return. JMP I TSTLAG / Return to process end-of-UNIT. CHKEOL, XX / Routine to see if current char is a line terminator. TAD CHAR / Get current character. AND P177 / Isolate just the char bits. TAD (-ECNWLN) / See if it's a LINE TERMINATOR char. SZA CLA / Skip if yes. process it. JMP CKEOL1 / Not line terminator, take 2nd return. ISZ NOMORE / Set NOMORE chars on line flag. SKP / Take 1st return. CKEOL1, ISZ CHKEOL / Not line terminator. Take 2nd return. JMP I CHKEOL / Return to caller. ECPTCH, XX / Routine to save character at posn ptd to by CURPTR. DCA T2 / Save character to save. CDFEDT / Map EDIT field. TAD I (CURPTR) / Get current text pointer. DCA T3 / Save so that we can indirect thru. CDFBUF / Map text field. TAD T2 / Get character to save. DCA I T3 / Save character. CDFMYF / back to our field. JMP I ECPTCH / return to caller. ECPSCN, XX / Routine to call SETCUR. CIFEDT / Call routine in editor field. CALEDT; SETCUR / routine will posn cursor to start of word. CDFEDT / routine DF to editor field. CDFEDT / Map editor field. TAD I (CURSOR) / Set screen posn same as CURSOR. DCA I (CURPOS) / ... CDFMYF / .... JMP I ECPSCN / Return to caller. NTFND4, AC7777 / Set flag to stop at next hyphen DCA HYPHEN / and rescan the word. TAD LINCNT / Get # of lines to start of word. /SB JMS ECSCRL / Scroll to the line in question. /SB JMS ECINI2 / Posn cursor to start of word. CLA /SB DCA NEWLIN / Reset "still on same line" flag. JMP SCNXT2 / Start rescanning the word. > /END IFDEF OLDSPL /SB /------------ /D002TSTSSC, XX /TEST FOR SUPERSCRIPT CHAR /SB /D002 ISZ TSTSSC /TO LOOK FOR NEXT /SB /D002 JMP I TSTSSC /GO BACK FOR MORE /SB /----------- IFDEF OLDSPL < /SB / /TSTCHR -- See if current character is ALPHA, NUMERIC, or OTHER. / /CALL: JMS TSTCHR AC=0 on input. / char=other return / char=numeric return / char=alpha-only return / / char is stored in T1 for subsequent reference. / /------------ TSTCHR, XX / Entry point. DCA CHAR / Save character. TAD CHAR / Get character. AND P177 / Isolate only the character bits. X="a&177 / First check for lower case characters. TAD (-X) / Compare against little "a". SPA / Skip if maybe. JMP TSTUPR / See if upper case. TAD ("a-"z) / See if within lowercase range. SMA SZA / Skip if ALPHA ONLY. JMP TSTOTH / Jmp to take OTHER return. TSTALP, ISZ TSTCHR / ALPHA-ONLY return. TSTNUM, ISZ TSTCHR / NUMERIC return. TSTOTH, CLA / OTHER return. JMP I TSTCHR / Return to caller. TSTUPR, TAD ("a-"A) / See if uppercase character. SPA / Skip if possible UPPERCASE. JMP TSNTAL / Definately not ALPHA-BETIC. See if numeric. TAD ("A-"Z) / See if within ALPHA-ONLY range. SMA SZA / Skip if ALPHA ONLY. JMP TSTOTH / Must be OTHER. JMP TSTALP / Jump to take ALPHA return. TSNTAL, TAD ("A&177) / Normalize. JMS TSTSPC / See if special (".", "-", or "'"). SNA / Skip if no. JMP TSTALP / Treat HYPHEN, PERIOD, and APOSTRAPHE as ALPHA. TAD ("'-"0) / See if numeric. SPA / Skip if maybe. JMP TSTOTH / Jmp if NO. Must be OTHER. TAD ("0-"9) / See if within NUMERIC range. SMA SZA / Skip if yes. JMP TSTOTH / Jmp if no. Must be OTHER. JMP TSTNUM / Take NUMERIC return. TSTSPC, XX / Routine to see if passed char is ".", "-", or "'". X=".&177 / AC returns 0 if yes, char - "'" if no. AND P177 / Isolate only the character bits. TAD (-X) / See if period. SZA / Skip if yes. TAD (".-"-) / See if initial dash (hyphen). SZA / Skip if yes. TAD ("--"') / See if initial apostrophe. JMP I TSTSPC / Return 0 for special, char - "'" if not. /------------ > /END IFDEF SPL /SB PAGE IFDEF OLDSPL < /A005 UNDOLG, XX / Routine to call FXSCRL. TAD LINCNT / Update # of lines in word. DCA LINCNT / ... ISZ NEWLIN / Say that a NEW LINE has been seen!!! UPDSCN / Update Screen (FXSCRL). JMP I UNDOLG / Return to caller. > /END IFDEF OLDSPL /A005 /----------- / /SLNMOD / / /----------- ECSLMD, XX / Routine to x-field call SETLMD (SLNMOD). CIFEDT / Call SETLMD to set screen update flags. CALEDT; SETLMD / ... CDFEDT / .... JMP I ECSLMD / Return to caller. /----------- / /ADVPTR / / /----------- ECAPTR, XX / Routine to call ESAPTR in edit field. CIFEDT / Move CURPTR to next character. CALEDT; ESAPTR / ADVPTR routine. CDFBUF / field to be mapped to. SKP / 1st return, take same return to caller. ISZ ECAPTR / Bump to correct return. JMP I ECAPTR / ... /----------- / /BKPPTR / / /----------- ECBPTR, XX / Routine to call ESBPTR in edit field. CIFEDT / Backup to where we were. CALEDT; ESBPTR / BKPPTR CDFBUF / .... SKP / Take 1st return. ISZ ECBPTR / Take 2nd return. JMP I ECBPTR / Return to caller. /----------- / /INSCHR / / /----------- ECICHR, XX / Routine to call ESICHR in edit field. CIFEDT / CALEDT; ESICHR / Call ESICHR CDFBUF / .... JMP I ECICHR / Return to caller. /----------- / /INSTCH /A005 / / /----------- ECNCHR, XX / Routine to call INSERT in edit field. CIFEDT / CALEDT; INSERT / Call INSERT CDFBUF / .... JMP I ECNCHR / Return to caller. /----------- / /GETCHR / / /----------- ECGCHR, XX / Routine to call CURMOV & LODCHR. CIFEDT / Call editor routine to insert character. JMS I (GETCH) / Call routine in editor field. SKP / Return via 1st return. ISZ ECGCHR / Return via 2nd return. JMP I ECGCHR / Return to caller. /----------- / /LOADCH / / /----------- ECLOAD, XX / Routine to call LODCHR. CIFEDT / Call editor routine to load character. CALEDT; LODCHR / ... CDFBUF / buffer field to be BUFFLD. SKP / Take 1st return. ISZ ECLOAD / Take 2nd return. JMP I ECLOAD / Return to caller. /----------- / /UPDSCN / / /----------- FXSCRN, XX / Routine to call FXSCRL in edit field. CIFEDT / CALEDT; FXSCRL / Call FXSCRL CDFEDT / .... JMP I FXSCRN / Return to caller. /----------- / /CHKSCN / / /----------- CKSCRN, XX / Routine to call TSTLIM & then FXSCRL. CIFEDT / CALEDT; TSTLIM / Call TSTLIM CDFEDT / .... UPDSCN / Call FXSCRL to repaint. JMP I CKSCRN / Return to caller. /----------- / /PUTERR - display error message on bottom line. / / /CALL: JMS PUTERR / display error message on bottom line. / ptr / pointer to a TEXT string for IOA. / /----------- PUTERR, XX / entry point. JMS SETMOD / set modes, ring bell, etc... TAD I PUTERR / Get error msg text pointer. TAD (-PCURST) / Is this the call to clear the error msg? SNA CLA / Skip if no. Ring the bell. JMP PUTER1 / Don't ring the bell if clearing the line. PUTCHR; BELL / Ring the bell. PUTER1, TAD I PUTERR / Get address of text string to display. ISZ PUTERR / Bump to return address. DCA PUTER2 / Save it for IOACAL. /SB CIFTXT / Call output IOA output routine in TXT field. JMS I (CALIOA) / display the message PUTER2, .-. / arg1 -2700 / arg2 PRSRTN / arg3 JMS RSTCUR / restore cursor and attributes. ISZ ECERFL / Say that there is an error msg being displayed. JMP I PUTERR / return to caller. /---------- / / /---------- SETMOD, XX JMS SAVCUR / save cursor posn and attributes. JMS SETABS / Set ORIGIN mode to ABSOLUTE mode. JMS CLRRV / Eliminate any current attributes. JMS SETRV / Error message gets output in reverse video. JMP I SETMOD IFDEF OLDSPL < /SB /---------- / / DSPTCH - routine to dispatch control / / / CALL: JMS DSPTCH / rtn1 / only return if: end of table encountered / / Inputs: / X1 - pointer to the dispatch table / T1 - character being matched to the dispatch table / (passed here in the AC) / / Outputs: / Control is passed to the appropriate routine, unless / a match is not made, in which case, return to caller / /---------- DSPTCH, XX / Return address DCA T1 / save the input char to check DSPTC1, ISZ X1 / bump rest of this entry. TAD I X1 / Check next table entry. SNA / Skip if there is one. JMP I DSPTCH / no more valid commands, return to process. TAD T1 / see if table entry matches desired command. SZA CLA / Skip if yes. JMP DSPTC1 / Check entry. TAD I X1 / Get address of routine to call. DCA T1 / Save for jump indirect thru. JMP I T1 / Dispatch to edit routine. > /END IFDEF OLDSPL /SB / / DSKERR - Issue error message, and wait for user to hit RETURN. Then / go to EOF to finish up and close files. / / Address of message is in AC on entry DSKERR, DCA DYSKE1 / set up for display CDFMYF / Back to our field. DYSKER, JMS PUTERR / Ring bell & display error msg. DYSKE1, .-. / arg1 JMS IPTCHR / Get an input character. TAD (-EDNWLN) / Return typed? SZA CLA / skip if yes. JMP DYSKER / Repeat message if not RETURN key. JMP EOF / Time to shut down!!! /---------- PAGE PTCHRS, XX / Routine to output a string of chars. PUTCH1, TAD I PTCHRS / Get next character to output. AND P177 / Isolate only the character bits. JMS OPTCHR / Output character. TAD I PTCHRS / Get character just output. ISZ PTCHRS / Bump to next char/return address. SPA CLA / Skip if last one was the last. JMP PUTCH1 / Go do next character. JMP I PTCHRS / Done! return to caller. / / / OPTCHR, XX / return address JMP OPTCH2 OPTCH1, CIFSYS JWAIT OPTCH2, CIFSYS TTYOU / output the char JMP OPTCH1 JMP I OPTCHR / return when done IFDEF OLDSPL < /A005 POSNCU, XX / Routine to init EDT pointers to start of / word & posn screen CURSOR. TAD SCURPT / Reinit text pointer. CDFEDT / CURPTR is in EDT field. DCA I (CURPTR) / ... TAD SCURSR / Reset cursor column address variable. DCA I (CURSOR) / .. TAD LINCNT / Reset cursor line address variable. CIA / DCA I (CURLIN) / "Current line number". CDFMYF / ... JMS ECPSCN / Call SETCUR to posn the cursor. JMP I POSNCU / return to caller. > / end ifdef OLDSPL /A005 /----------- / / GRAFXS - set graphics mode / / / CALL: JMS GRAFXS AC ignored & destroyed on return / / ESC ( 0 / /----------- GRAFXS, XX / return address PUTCHR; 4000+ESC / output escape sequence to the terminal 4000+"( / "0&177 / JMP I GRAFXS / return to caller /----------- / / GRAFXC - clear graphics mode / / / CALL: JMS GRAFXC AC ignored & destroyed on return. / / ESC ( B / /----------- GRAFXC, XX / return address PUTCHR; 4000+ESC / output escape sequence to the terminal 4000+"( / "B&177 / JMP I GRAFXC / return to caller /----------- / /SETRGN - Set scrolling region up. / / /CALL: JMS SETRGN AC ignored & destroyed on return. / / ESC [ 3 ; 11 r / /----------- SETRGN, XX / entry point. PUTCHR; 4000+ESC / define scrolling region from line 3 to 13 4000+"[ / Send escape sequence to terminal to 4000+"3 / From line 3, 4000+"; / ... 4000+"2 / to line /C003 4000+"2 / 22 /C003 "r&177 / terminator. JMS SETREL / Set ORIGIN mode to RELATIVE (relative to region). JMP I SETRGN / Return to caller. IFDEF OLDSPL < /A003 /----------- / / STMRGN - Set scrolling region for help menus. / / / CALL: JMS STMRGN AC ignored & destroyed on return. / / ESC [ 16 ; 24 r / /----------- STMRGN, XX / return address PUTCHR; 4000+ESC / output the escape sequence to the terminal 4000+"[ / define scrolling region 4000+"1 / from line 14, 4000+"4 / ... 4000+"; / to line 4000+"2 / 24 4000+"4 / ... "r&177 / JMP I STMRGN / return to caller > / end ifdef OLDSPL /A003 /----------- / /CLRRGN - Clear scrolling region upon exit. / / /CALL: JMS CLRRGN AC ignored & destroyed on return. / / ESC [ r / /----------- CLRRGN, XX / entry point. PUTCHR; 4000+ESC / Send escape sequence to terminal to 4000+"[ / undefine scrolling region. "r&177 / terminator. JMS SETABS / Set ORIGIN mode to absolute. JMP I CLRRGN / Return to caller. /----------- / /SETREL - Set ORIGIN mode to relative. / / /CALL: JMS SETREL AC ignored & destroyed on return. / / ESC [ ? 6 h / /----------- SETREL, XX / Entry point. PUTCHR; 4000+ESC / Send escape sequence to terminal. 4000+"[ / ... 4000+"? / ... 4000+"6 / ORIGIN mode "h&177 / relative. JMP I SETREL / Return to caller. /----------- / /SETABS - Set ORIGIN mode to absolute. / / /CALL: JMS SETABS AC ignored & destroyed on return. / / ESC [ ? 6 l / /----------- SETABS, XX / Entry point. PUTCHR; 4000+ESC / Send escape sequence to terminal. 4000+"[ / ... 4000+"? / ... 4000+"6 / ORIGIN mode "l&177 / absolute. JMP I SETABS / Return to caller. /----------- / /SAVCUR - Save cursor and attributes. / /CALL: JMS SAVCUR AC ignored and destoryed on return. / / ESC 7 / /----------- SAVCUR, XX / entry point. PUTCHR; 4000+ESC / Output escape sequence to save cursor & attr. "7&177 / ... JMP I SAVCUR /----------- / /RSTCUR - Restore cursor and attributes. / /CALL: JMS RSTCUR AC ignored and destoryed on return. / / ESC 8 / /----------- RSTCUR, XX / entry point. PUTCHR; 4000+ESC / Output escape sequence to restore cursor & attr. "8&177 / ... JMP I RSTCUR /----------- / / SETRV - Set screen to reverse video mode. / / / CALL: JMS SETRV AC is 0 on entry & return. / / ESC [ 7 m / /----------- SETRV, XX PUTCHR; 4000+ESC / Output escape sequence to set terminal attributes. 4000+"[ / 4000+"7 / "m&177 / JMP I SETRV / Return to caller. /----------- / / CLRRV - Reset screen of all attributes. / / / CALL: JMS CLRRV AC is 0 on entry & return. / / ESC [ 0 m / /----------- CLRRV, XX PUTCHR; 4000+ESC / Output escape sequence to set terminal attributes. 4000+"[ / 4000+"0 / "m&177 / JMP I CLRRV / Return to caller. /----------- / / STBOLD - set bold / / / CALL: JMS STBOLD AC ignored & destroyed on return. / / ESC [ 1 m / /----------- STBOLD, XX / return address PUTCHR; 4000+ESC / output escape sequence to the terminal 4000+"[ / 4000+"1 / "m&177 / JMP I STBOLD / return to caller /----------- / / STUNDR - set underline mode / / / CALL: JMS STUNDR AC ignored & destroyed on return. / / ESC [ 4 m / /----------- STUNDR, XX / return address PUTCHR; 4000+ESC / output escape sequence to the terminal 4000+"[ / 4000+"4 / "m&177 / JMP I STUNDR / return to caller /------ PAGE /---------- / / DISDOCNAME - / / This routine will display the document (name & number) / being corrected, centering it on the top line of the screen. / /---------- DISDOCNAME, XX / return address / /SB CIFTXT JMS I (CALIOA) / CLREOS / erase the screen 0 / line to start clearing from NOP / (filler) / CDFMNU /***** / data field to menu TAD I (MUBUF+MNDRV) / Get drive #. DCA DOCDRV / save for IOA. TAD I (MUBUF+MNDOCN) / Get document #. DCA DOCNUM / save that too. AC7777 TAD I (MUBUF+MNFNAM) / set up a pointer to the filename CDFMYF /***** / back to my field DCA X1 / and save the pointer TAD X1 / ... DCA X2 / and save a copy DCA T1 / initialize a counter for length of word / The following 2 routines position the cursor so that the / document name will be centered on the screen / First, find the length of the document name / DISDO1, CDFMNU /***** / data field to menu TAD I X1 / CDFMYF /***** / back to my field SNA CLA / skip if: have not found end of filename JMP DISDO2 / found end of name, exit ISZ T1 / bump counter JMP DISDO1 / and continue / / T1 now contains the length of the word, get the width of the screen / and find the starting location for the paint of the name / DISDO2, CDFEDT /***** / edit field TAD I (SPLTFL) / wide screen? CDFMYF /***** / my-field SZA CLA / skip if: normal screen TAD (32) TAD (45) DCA T2 / pointer to center of screen / TAD T1 / get document name length CLL RAR / divide length by 2 CIA / make negative TAD T2 / subtract from mid-screen DCA DISD2A / set up position to start paint from /SB CIFTXT JMS I (CALIOA) / ... PCURSTRING / ... DISD2A, .-. / ... NOP / (filler) /SB CIFTXT / Display '(drive.doc) ' JMS I (CALIOA) / ... DISTXT / text string. DOCDRV, 0 / drive # of the document. DOCNUM, 0 / document # of the document. DISDO3, / now display the document name CDFMNU /***** TAD I X2 CDFMYF /***** SNA JMP DISDO4 / JMS OPTCHR / output the character / JMP DISDO3 / continue with next / DISDO4, JMP I DISDOCNAME / return to caller /---------- / / SOLIDLINE - / / This routine will paint the 2 lines delimiting the scrolling region. / /---------- SOLIDLINE, XX / callers return address JMS GRAFXS / switch to grafix JMS SETCNT / set up counter for width of screen /SB CIFTXT JMS I (CALIOA) PCURSTRING 100 / position cursor to start of line 2 NOP / (filler) JMS LOOPS / display first line JMS SETCNT / set up counter for width of screen /SB CIFTXT JMS I (CALIOA) PCURSTRING 2600 / position cursor to start of line 26 /C003 NOP / (filler) JMS LOOPS / display second line JMS GRAFXC / restore SI JMP I SOLIDLINE / return to caller / / routine to print horizontal line (scan 5) to screen / LOOPS, XX / return address LOOPA, TAD (161) / horizontal line, (scan 5) JMS OPTCHR / print the char ISZ T1 / bump the character count JMP LOOPA / loop for more JMP I LOOPS / return to caller / / routine to set up counter for width of screen / SETCNT, XX CDFEDT / from edit field. TAD I (SPLTFL) / wide screen? CDFMYF / Back to current field. SZA CLA / skip if: narrow screen TAD (64) TAD (120) CIA DCA T1 / counter for number of prints JMP I SETCNT / return /---------- / / RVBKGRND - / / Reverse video the background of the menu line. / /---------- RVBKGRND, XX / return address JMS SETRV / set reverse video mode /SB CIFTXT JMS I (CALIOA) / position the cursor on the menu line PCURSTRING 2000 NOP / (filler) TAD MENULEN / length of menu line (-62) DCA T1 / set up as a counter TAD (ECSPC) / output spaces JMS OPTCHR / ... ISZ T1 / bump the character count JMP .-3 / loop 'till done JMS CLRRV / clear reverse video JMP I RVBKGRND / return to caller MENULEN, -62 / minus the length of the menu line /---------- / / MNUPNT - Paint the initial menu line / /---------- MNUPNT, XX / JMS RVBKGRND / reverse video the background of the menu line AC7777 / DCA OFFSET / clear display at start-up /SB JMS MENULINE / display the menu line JMP I MNUPNT / return /---------- PAGE IFDEF OLDSPL < /SB ECDOIN, XX / Routine to check for allowable insert & do it. /SB TAD NOINSR / Check for End-Of-Line encountered. /SB SZA CLA / Skip if not at End-Of-Line yet. /SB JMP INSERR / Report insert error (e-o-l reached). TAD T1 / Get character to insert. INSCHR / Insert char into document. SLNMOD / Set "modified" flag. TAD T1 / Get character back. TAD (-ECSTOV) / Start of "Dead Key Sequence"? SNA / Skip if no. JMP DOINS1 / Go handle start of DEAD-KEY-SEQUENCE. TAD (ECSTOV-ECNDOV) / End of "Dead Key Sequence"? SNA CLA / Skip if no. JMP DOINS2 / Jmp to process End of DEAD-KEY-SEQUENCE. TAD INSDKS / Are we currently in a DEAD-KEY sequence? SNA CLA / Skip if YES. JMP DOINS4 / No. go handle regular insert. BKPPTR / continue overstrike mode. See if prior char NOP / is END-OF-DEAD-KEY. TAD (-ECNDOV) / Check prior char for end-of-deadkey. SZA CLA / Skip if yes. insert char there instead. JMP DOINS3 / No. cancel dead-key seq. JMS ECPTCH / Cancel prior end-of-deadkey. ADVPTR / Advance to char just inserted. NOP / ... DOINS1, ADVPTR / Advance just beyond char just inserted. NOP / ... CLA TAD (ECNDOV) / Insert End-Of-Deadkey sequence char. INSCHR / ... ADVPTR / Advance beyond end-of-deadkey char just inserted. NOP / ... AC0001 / Say that we're in a dead-key sequence. JMP DOINS5 / done. DOINS2, JMS ECPTCH / Cancel redundant end-of-deadkey. CDFEDT / Bump cursor posn to next col. ISZ I (CURSOR) / ... CDFMYF / .... JMP DOINS5 / done. DOINS3, ADVPTR / Bump past char just inserted. NOP / ... CLA DOINS4, CIFEDT / Do rejustification (if necessary). CALEDT; CHKREJ / Call CHKREJ to see if rejustification CDFBUF / is appropriate. DOINS5, DCA INSDKS / Cancel/Set overstrike mode. /SB AC7777 / Check restart CURSOR/CURPTR for insert. /SB JMS CRSTRT / Check restart CURSOR/CURPTR. TAD T1 / Get prior char (ie. the one just inserted.) JMS TSTCHR / Check it's type. JMP DOINS6 / OTHER. See if we were at End-Of-Line. JMP DOINS7 / NUMERIC & JMP DOINS7 / ALPHA-ONLY are always insertable. DOINS6, JMS TSTLAG / See if on same line as word was on. JMP DOINS7 / YES. char does not define new E-O-L. ISZ NOMORE / We just inserted a new E-O-L definition. ISZ NOINSR / so stop further ADVANCE & INSERT. DOINS7, JMP I ECDOIN / Return to caller. Char is inserted & flags set. INSDKS, .-. /SBINSERR, JMS PUTERR / Display error. /SB ERREOL / "End of line reached" error message. /SB JMP ECFIX3 / Reset MODE to ADVANCE & get next input. /----------- PAGE PAGE > /END IFDEF OLDSPL /SB / Footnote I/O Buffer /A003 / Used to read/write footnote text from/to the scratch area on the/A003 / WPS Utility Diskette. /A003 FNIOBF, ZBLOCK 400 /A003 PCURST, TEXT /^P/ CLREOS, TEXT /^P!E/ DISTXT, TEXT /(^D.^D) / ERRFEM, IFDEF ENGLSH >).^S/> /M005 IFDEF ITALIAN>).^S/> ERRRWF, IFDEF ENGLSH /M005 IFDEF ITALIAN ERRUEF, IFDEF ENGLSH /M005 IFDEF ITALIAN ERRFSE, IFDEF ENGLSH /M005 IFDEF ITALIAN ERRFNR, IFDEF ENGLSH /M005 IFDEF ITALIAN ERRFNW, IFDEF ENGLSH /M005 IFDEF ITALIAN ERRHLT, IFDEF ENGLSH /M005 IFDEF ITALIAN< TEXT /^P&ANNULLO OPERAZIONE DOPO AVER PREMUTO !&ORO !&STOP.^S/> ERRIRC, IFDEF ENGLSH /A004 IFDEF ITALIAN ERRFCB, IFDEF ENGLSH /M010 IFDEF ITALIAN< TEXT /^P&DESCRITTORE RIGA NON VALIDO NEL BLOCCO DI CONTROLLO.^S/> PRSRTN, IFDEF ENGLSH /ARCM IFDEF ITALIAN / Footnote ruler buffer. Footnote ruler, if one exists, is stored here. /A005 FNRLBF, ECSTRL; ECMDRL / Beginning of footnote ruler /A005 ZBLOCK 50^3+2 / Storage for footnote ruler /A005 FNRLBE=. / Space for 40 settings + ruler end /A005 / Current ruler in effect at time footnotes are dumped is saved here. /A005 CURLBF, ECSTRL; ECMDRL / Beginning of storage for saved ruler /A005 ZBLOCK 50^3+2 / Storage for saved ruler /A005 CURLBE=. / Space for 40 settings + ruler end /A005 /----------- PAGE *6000 /HOPEFULLY TEMPORARY /SB OPENER, XX /CALLED TO OPEN POST PROCESSOR FILES /SB RDF /NEED TO FIND WAY BACK TO RIGHT FLD /SB TAD CIDF0 /GET BLANK FLD CHANGE INST /SB DCA OPENEX /PLUG INTO RETURN PATH /SB CDFMNU /OUTPUT FILENO IS IN MENUFLD /SB TAD I (MUBUF+MNFNO) /WHERE IT USUALLY IS /SB MQL /WPFILS EXPECTS IT IN MQ /SB TAD I (MUBUF+MNTMP1) /NEED T-B-O OPTION (0 1 -1) /SB CDFMYF /BACK HERE /SB CIFFIO;FILEIO;XDSKIN /OPEN FILE FOR INPUT OR OUTPUT /SB SPA;NOP;CLA /A LOT OF NECESSARY NOTHING /SB /NOWGET READY TO OPEN FILE FOR INPUT ONLY /SB TAD (XRDFNC) /NEXT 4 PAIRS ARE MAGIC FROM OVMRG1 /SB CDFEDT /MG LABELS ARE IN EDITOR /SB DCA I (MGPTC1) /SB CLA /SB TAD (SKP CLA) /SB DCA I (MGPTC2) /SB TAD I (MGPTC2) /AGAIN /SB DCA I (MGPTC3) /SB CLA /SB TAD (ESGETX&177+4600) /SB DCA I (MGPTC4) /SB TAD (FLINES / Get # lines in Footnote scroll region /A003 DCA I (SCRNLN / Store in edit screen size /A003 TAD (FLINES / /A003 DCA I (WIDSIZ / and in wide screen size, too /A003 CDFMNU /GET LAST FILENO /SB TAD I (MUBUF+MNFNO) /IE 'RESULT' FILE /SB CDFMYF /PUT NEAR SAVED INPUT FILE /SB DCA INFNO-1 / DCA I (OPENER+1) /IS CUB2+1 IN WPCUT /SB TAD 7500 / TAD I (OPENER) /SAVED INPUT FILE /SB CDFMNU /SB DCA I (MUBUF+MNFNO) /PLUG IN FOR FUTURE REFERENCES /SB CDFMYF /BACK HERE /SB TAD 7500 /NOW HERE /SB NOP /SB MQL /WPFILS EXPECTS IT HERE /SB CIFFIO;FILEIO;XRDFIN /OPEN FOR INPUT ONLY /SB SPA;NOP;CLA /IS THIS ALL NECESSARY /SB TAD INFNO-1 /RETRIEVE RESULT FILE # /SB CDFMNU /WANT TO PUT IT IN MNFNO /SB DCA I (MUBUF+MNFNO) /TO CONINCIDE WITH REMEMBERED FILE NAME /SB CDFMYF /DON'T LOSE TRACK OF WHERE WE ARE NOW /SB OPENEX, XX /GETS FILLED WITH RETURN CIF /SB JMP I OPENER /THAT'S ALL FOLKS /SB /---------- / / SCRNINIT - This routine sets up the initial screen display prior / to the start of the corrector portion of the feature. / / 1) Display the document name. / 2) Delimit the scrolling region by solid lines. / 3) Display the main menu line. / 4) Set up the scrolling region to range from lines 3 to 13. / 5) Pass control to the Main Scrolling Loop. / /---------- *6077 /******TEMP ****** /SB SCRNINIT, XX / save callers return address RDF / Get return field. TAD CIDF0 / Make a return CIF CDF instruction. DCA SCRNXT / save for the exit. CDFMYF / Map our field for the duration of our stay. JMS SETABS / Set screen orgin mode to ABSOLUTE. JMS DISDOCNAME / display and save document name JMS SOLIDLINE / paint the solid lines /SB TAD INEDIT / Are we currently in edit mode? /SB SZA CLA / Skip if no. Paint just paint menu line. /SB JMP SCRNI1 / Jmp if currently editting. /SB JMS MNUPNT / Paint the menu line. /SB JMP SCRNI2 / Merge below to finish up screen initialization. /SB /SBSCRNI1, JMS EFXMUP / Display 'editting' message. SCRNI2, JMS SETRGN / set up the scrolling region for the / document being corrected / SCRNXT, XX / Return CIF CDF goes here. JMP I SCRNINIT / return to caller /---------- PAGE *7500 /HOPEFULLY TEMPORARY /SB INFNO, 0 /TEMP /SB FIELD 3 /AUXILIARY FIELD *200 BUFADR, /BUFFER FOR I/O STARTS HERE ZBLOCK 400 /RESERVE 2 PAGES PAGE NOPUNCH /DECMATE II GRAPHICS PRIMITIVES / 0055A 16-AUG-84 /FIELD FIX LOST IN CONVERSION VER= 0055 /LATEST VERSION NUMBER OF THE PROGRAM / / VERSION 55 - 31 JUL 84 - KAH - ADD MONOCHROME MAP FOR NEW BOARDS; / LOAD COLOR OR MONOCHROME MAP WHEN 'GRAPHICS / TO MONOCHROME MONITOR' SELECTION CHANGED. / VERSION 54 - 27 JUL 84 - KAH - ADD DECMATE III AND NEW/OLD GRAPHICS BOARD / TESTS TO DO THE RIGHT THING; / MODIFY POWER-UP ROUTINE TO HANDLE WHATEVER / COMBINATION OF DECMATE AND BOARD WE FIND; / MODIFY CONFIGURATION SET-UP TO HANDLE WHATEVER / COMBINATION OF DECMATE AND BOARD WE FIND; / ADD COLOR MAP INITIALIZATION FOR NEW BOARD. / VERSION 53 - 16 JUL 83 - KAH - USE TEXT PIXEL VECTORS FOR 45 DEGREE CELL / ROTATION (HAD FORCED TO 0 DEGREE PIXEL / VECTORS). / VERSION 52 - 02 JUL 84 - KAH - CHANGE SCREEN ERASE TO AVOID 32 PIXELS AT / RIGHT OF SCREEN (DO ONLY 800, NOT 832); / CLIP NUMBER OF DOTS TO DRAW IF TEXT CELL IS / LARGER THAN UNIT SIZE. / VERSION 51 - 18 JUN 84 - KAH - PREVENT SYSTEM CRASH ON LARGE TEXT SIZES BY / ADDING AN UNSIGNED DIVIDE ROUTINE (HAD GOTTEN / OVERFLOW IN PREVIOUS MULTIPLY); / TRUNCATE TEXT CELL AND UNIT DIMENSIONS TO 400 / DECIMAL ON INPUT TO PREVENT OVERFLOW IN LATER / CALCULATIONS. / ** VERSION 50 IN FIELD TEST VERSION 43 ** / VERSION 50 - 16 MAY 84 - KAH - ALLOW CURSOR TO BE DISPLAYED IN W(N1) MODE. / VERSION 47 - 14 MAY 84 - KAH - FIX UPSIDE-DOWN CHARACTERS (HAD HORZONTAL / BARS IN THEM); / TEST FOR GRAPHICS BOARD PRESENT AND IGNORE / SUBSEQUENT REQUESTS IF NO BOARD; / AVOID DRAWING CHARACTER DOTS BELOW CELL / HEIGHT. / VERSION 46 - 09 MAY 84 - KAH - GET CELL WIDTH IN PHYSICAL PIXELS FOR TEXT / APRON (HAD BEEN LOGICAL PIXELS, DOING TOO MUCH / ON BASELINE ANGLES OF 90 AND 270). / VERSION 45 - 04 MAY 84 - KAH - ADD BIT<06> TO COMMAND 34'S SETUP WORD FOR / REQUESTING A RESYNCHRONIZATION OF THE VIDEOS / (NEEDED WHEN COLUMN WIDTH CHANGES); / ADD DOCUMENTATION ON GRAPHICS BOARD REGISTERS. / VERSION 44 - 01 MAY 84 - KAH - DON'T DRAW TEXT OUTSIDE SCREEN. / VERSION 43 - 23 APR 84 - KAH - CHANGE CURSOR TO A CROSS-HAIR; / HANDLE NEGATIVE ANGLES FOR TEXT CHARACTER / ORIENTATION AND BASELINE ANGLE; / EXTEND SCREEN ERASE TO GET EXTRA 32 PIXELS / AT RIGHT OF SCREEN; / ENSURE CURRENT POSITION LEFT AT STARTING / POINT OF A CLOSED CURVE. / VERSION 42 - 17 APR 84 - KAH - PRELIMINARY WORK TO ALLOW CHARACTER / CLIPPING (HORIZONTAL APRON). / VERSION 41 - 13 APR 84 - KAH - USE MINIMUM OF EIGHT DOTS FOR CHARACTER / UNIT WIDTH WHEN CELL ROTATION IS 90 OR 270; / AVOID DRAWING CHARACTER CELL APRON IF CELL / ALREADY FULL (OR OVERFULL). / VERSION 40 - 05 APR 84 - KAH - CHANGE READ SCREEN FROM DMAR TO RDAT / (HAD MISREAD SCREEN DATA SOMETIMES); / COMPLEMENT ALL PLANES FOR COMPLEMENT WRITING / MODE; / CHANGE POWER-ON SYNCH ARGS TO AVOID SCREEN / TEARING, CAN DO CAUSE NO LONGER USING DMA; / CHANGE TEST FOR SPEEDY TEXT TO INCLUDE NEGATE / OFF; / MOVE COMMAND DISPATCH TABLE TO TABLE FIELD / TO MAKE ROOM FOR CODE. / VERSION 37 - 18 FEB 84 - KAH - SPEED TEXT DRAWING IN REPLACE WRITING MODE / AND NON-ITALICIZED BY DRAWING CELL FIRST AND / DRAWING CHARACTER IN OVERLAR MODE SECOND; / SPEED UP TEXT DRAWING BY CHECKING IF REMAINING / DOTS IN CHARACTER ROW ARE ZERO, IF SO THEN / DO THEM WITH THE CELL APRON. / VERSION 36 - 17 FEB 84 - KAH - ADD TEXT DISABLE AND GRAPHICS DISABLE TO / THE 'PASS SETUP PARAMS' COMMAND; / FIX TEXT SAVE/RESTORE COMMANDS. / VERSION 35 - 15 FEB 84 - KAH - INVERT CURSOR ORIENTATION ONLY WHEN / ABOUT TO GO OFF SCREEN; / RELEASED WITH VERSION 17-F PRE-FIELD TEST. / VERSION 34 - 14 FEB 84 - KAH - USE TEXT CELL SIZE AND ORIENTATION FOR / TEXT PIXEL VECTORS AND LINE FEEDS. / VERSION 33 - 13 FEB 84 - KAH - FIX TEXT 'DOT' DRAWING; / DRAW EACH CHARACTER 'DOT ROW' TO CELL / BOUNDARY. / VERSION 32 - 13 FEB 84 - KAH - FIX DISPLAY OF SMALL CHARACTER DESCENDERS; / COMBINE LIKE DOTS FOR DRAWING SMALL CHARACTERS. / VERSION 31 - 09 FEB 84 - KAH - FIX SCREEN ERASE AND ERASE MODE WRITING; / FIX SHADE WITH PATTERN; / TREAT CHARACTER ROTATIONS OF 45 DEGREES AS / THE NEXT LOWER 90 DEGREE ANGLE; / DRAW CORRECT SIZE OF CHARCTER 'DOTS'; / AVOID DRAWING 'DOTS' THAT WILL HAVE NO / AFFECT; / COMBINE 'DOTS' BEFORE DRAWING SMALL CHARACTERS; / FIX 'DOT' SIZE IN ITALIC CHARACTERS. / VERSION 30 - 05 FEB 84 - KAH - CHANGE TEXT DISPLAY TO DRAW DOTS; / WRITE ALL FOUR REGISTERS TWO (TO ALLOW FOR / LATER GRAPHICS DISABLE); / CHANGE POWERUP CODE TO WRITE ALL REGISTERS TWO; / FIX DIVIDE AND MULTIP ROUTINES; / INITIALIZE NEW TEXT PARAMS AT POWERON; / INCREASE TEXT OPTION SAVE BUFFER SIZE; / FIX SETUP TO ALLOW GRAPHICS TO MONOCHROME; / COPY PRAM STRING IN 'DRAW' SO ORIGINAL / STRING IS UNCHANGED. / VERSION 27 - 03 FEB 84 - KAH - FIX COPYING OF TEXT PARAMS; / TRY TO FIX TEXT PIXEL VECTORS; / PRE-COMPUTE TEXT DRAWING PARAMETERS; / CHANGE CURSOR PATTERN FOR SYMMETRY. / VERSION 26 - 30 JAN 84 - KAH - FIX TEST FOR REPLACE MODE IN 'DRAW'; / COPY TEXT PARAMS TO MAIN FIELD WHEN CHANGED; / USE NEW SET OF TEXT PARAMS; / DELETE CHECK FOR TEXT ON SCREEN; / DELETE CHECK FOR ITALIC AND CELL ROTATION; / FIX TEXT PIXEL VECTORING; / ENLARGE CURSOR. / VERSION 25 - 27 JAN 84 - KAH - FIX DISPATCH TO NEW FIELD; / FIX HANDLING OF TEXT PARAMETERS; / USE DEFUALTS FOR INVALID PARAMETERS; / SPEED UP 'DRAW' BY PASSING PRAM STRING / SEPARATELY; / CHANGE TEST FOR REPLACE MODE IN 'DRAW'; / ADD INITIALIZE ROUTINE FOR TABFLD CODE; / ADD SAVE/RESTORE TEXT OPTIONS COMMANDS; / DELETE UNUSED CODE (GETDEG, CSETUP, TIMSIZ); / CHANGE TEXT PIXEL VECTOR CODE; / REMOVE ZOOM FROM DISPLAY TEXT CODE. / VERSION 24 - 23 JAN 84 - KAH - FIX SCREEN ERASE; / ADD NEW TEXT PARAMS OPCODE (42.); / DELETE OLD TEXT PARAMS ROUTINES; / DELETE TEXT OPTIONS SAVE/RESTORE ROUTINES; / IGNORE ITALICS FOR TEXT PIXEL VECTORING; / PARAMETERIZE GDC COMMAND STRINGS TO ALLOW / FUTURE PERFORMANCE BOOST. / VERSION 23 - 19 JAN 84 - KAH - EXPECT 8X10 CHARACTERS IN BITMAP; / DELETE REFERENCES TO ALPHABET EXTENT; / SCREEN ERASE GETS APRON, TOO; / ADD 'HT' SUPPORT IN TEXT STRING; / DON'T MOVE CURSOR AT START/END OF TEXT; / TURN CURSOR OVER AT BOTTOM OF SCREEN. / / 15-DECEMBER-1983 BRUCE R. HANSEN - PASSED VERSION 22 TO KENNY HOUSE. / IFNDEF CONDOR < PRMFLD= 3 /FIELD OF THE PRIMITIVE ROUTINES PBMFLD= 5 /PANEL RAM CHARACTER BIT MAP FIELD PRGFLD= PRMFLD^10 /USED BY CDF INSTRUCTIONS & PANEL RAM REQUEST TABFLD= 5 /EXTRA FIELD FOR USER CODE TBLFLD= TABFLD^10 > /END IFNDEF CONDOR FIELD PRMFLD NOPUNCH PWRUP /OPCODE=00 HARDWARE POWER UP POSTN1 /OPCODE=01 MOVE TO SPECIFIED POSITION SVTMPW /OPCODE=02 SAVE TEMPORARY WRITE OPTIONS RSTMPW /OPCODE=03 RESTORE TEMPORARY WRITE OPTIONS GETVEC /OPCODE=04 DRAW A VECTOR GTNEGM /OPCODE=05 DISABLE/ENABLE NEGATE MODE SCRNER /OPCODE=06 SCREEN ERASE GETDRG /OPCODE=07 SET DISPLAY REGION - SCREEN TO BALCK GTBGRD /OPCODE=08 SELECT BACKGROUND COLOR GTFGRD /OPCODE=09 SELECT FOREGROUND COLOR GTWRTM /OPCODE=10 SET WRITING MODE GTLTXT /OPCODE=11 SET LINE TEXTURE GTSHDY /OPCODE=12 SHADE TO Y GTSHDO /OPCODE=13 TURN SHADING OFF SCRDMP /OPCODE=14 SCREEN SIXEL DUMP DRWARC /OPCODE=15 CENTER ARC CRVBGN /OPCODE=16 CURVE BEGIN OPEN CRVCLS /OPCODE=17 CURVE BEGIN CLOSED CRVCNT /OPCODE=18 CURVE CONTINUE CRVEND /OPCODE=19 CURVE END GTPLNS /OPCODE=20 GET PLANE SELECT MASK WORD GETTXT /OPCODE=21 DISPLAY CHARACTER DMYSUB /OPCODE=22 NOP (WAS CELL CURSOR MOVEMENT) GTCSIZ /OPCODE=23 CLEAR ALPHABET DMYSUB /OPCODE=24 NOP (WAS CELL DISPLAY SIZE (ZOOM)) DMYSUB /OPCODE=25 NOP (WAS CELL ROTATION) DMYSUB /OPCODE=26 NOP (WAS CELL ITALIC) DMYSUB /OPCODE=27 NOP (WAS SELECT ALPHABET FOR DISPLAY) GTCBMP /OPCODE=28 LOAD CHARACTER BIT MAP INIT /OPCODE=29 SOFTWARE INITIALIZE MORCOD /OPCODE=30 SAVE TEXT OPTIONS MORCOD /OPCODE=31 RESTORE TEXT OPTIONS RETPOS /OPCODE=32 REQUEST CURSOR POSITION TRMNTE /OPCODE=33 TERMINATE GRAPHICS (INIT-CURSOR OFF) SETUP /OPCODE=34 SETUP - CURSOR + GRAPHICS/TEXT SCREEN DMYSUB /OPCODE=35 NOP - NO OPERATION GTLMLT /OPCODE=36 SELECT LINE PATTERN MULTIPLIER RETREG /OPCODE=37 RETURN CO-ORDINATES OF LOGICAL SCREEN GTTXTR /OPCODE=38 SET TEXT REFERENCE POSITION RSTCUR /OPCODE=39 RESTORE CURSOR AFTER TEXT STRING GTXTPV /OPCODE=40 TEXT PIXEL VECTOR MOVEMENT DMYSUB /OPCODE=41 DRAW MARKER MORCOD /OPCODE=42 TEXT PARAMETER SETUP ENPUNCH / ----------------------------- / GRAPHICS BOARD REGISTER USAGE / ----------------------------- / / STATUS REGISTER (READ ONLY) / / BIT MEANING / 11 1=DATA READY, 0=NO DATA READY OR DATA BEING TRANSFERRED / 10 1=FIFO FULL, 0=FIFO NOT FULL / 09 1=FIFO EMPTY, 0=FIFO NOT EMPTY / 08 1=DRAWING IN PROGRESS, DRAWING NOT IN PROGRESS OR END OF LINE / 07 1=DMA TRANSFER IN PROGRESS, 0=DMA TRANSFER NOT IN PROGRESS / 06 1=VERTICAL RETRACE IN PROGRESS, 0=VERTICAL RETRACE NOT IN PROGRESS / 05 1=HORIZONTAL RETRACE IN PROGRESS, 0=HORIZ RETRACE NOT IN PROGRESS / 04 1=LIGHT PEN DETECT -- NOT IMPLEMENTED -- / 03 1=DMA DATA READY, 0=NO DMA DATA READY / 00-02 UNUSED / / / REGISTER ONE / / BIT MEANING / 10-11 WRITE-BACK REGISTER / 08-09 WRITE-BACK REGISTER / 06-07 WRITE-BACK REGISTER / 04-05 REGISTER TWO ADDRESS / 03 1=EXTERNAL SYNC, 0=INTERNAL SYNCH / 02 1=ENABLE COMPOSITE VIDEO TO SBC (GRAPHICS TO MONOCHROME) / 01 UNUSED / 00 1=ENABLE VIDEO (GRAPHICS ENABLE) / / / REGISTER TWO / / BIT MEANING / 09-11 D-TO-A FOR GREEN GUN / 08 1=ENABLE SBC VIDEO (TEXT) TO GREEN / 05-07 D-TO-A FOR RED GUN / 04 1=ENABLE SBC VIDEO (TEXT) TO RED / 01-03 D-TO-A FOR BLUE GUN / 00 1-ENABLE SBC VIDEO (TEXT) TO BLUE / CHARACTER BIT MAPS (7-BY-9 CHARACTER FONT) / / TOP / / 00 000 000 / XX XXX XX0 / XX XXX XX0 / XX XXX XX0 / RIGHT XX XXX XX0 LEFT / XX XXX XX0 / XX XXX XX0 / XX XXX XX0 / XX XXX XX0 (DESCENDER) / XX XXX XX0 (DESCENDER) / / BOTTOM / / /*/*/* EQUATES /*/*/* / PR3= 6236 /PANEL REQUEST FOR BLOCK MOVE SRNLHX= 0 /LEFT HORIZONTAL X PHYSICAL CO-ORDINATE SRNRHX= 1440 /RIGHT HORIZONTAL X PHYSICAL CO-ORDINATE +1 SRNUVY= 0 /UPPER VERTICAL Y PHYSICAL CO-ORDINATE SRNLVY= 740 /LOWER VERTICAL Y PHYSICAL CO-ORDINATE +1 SE= 6 /OPERATION CODE FOR SCREEN ERASE PWR= 0 /OPERATION CODE FOR POWER UP *0000 GRFX, 7777 /GRAPHICS BOARD PRESENT? (0=NO, -1=YES) / ASSUME PRESENT UNTIL TESTED AT POWERON CLEAR. GOBTYP, 0 /GRAPHICS OPTION BOARD TYPE / (0=OLD BOARD, 1= NEW BOARD) DECMAT, 0 /DECMATE SYSTEM TYPE (0=DECMATE II, 1=DECMATE III) / *7 VERNUM, VER /LATEST VERSION NUMBER OF PROGRAM AUTO10, 0 AUTO11, 0 AUTO12, 0 AUTO13, 0 AUTO14, 0 AUTO15, 0 AUTO16, 0 AUTO17, 0 / ACHW, 0 ACLW, 0 MQHW, 0 MQLW, 0 SRH, 0 SRL, 0 OPCODE, 0 /OPERATION CODE OF FUNCTION BEING EXECUTED REG1HI, 0 /HIGH SIX BITS OF GRAPHICS REGISTER ONE, / GETPRM= JMS I . /GET A PARAMETER FROM THE CALLING FIELD XGTPRM PUTPRM= JMS I . /STORE PARAMETER INTO CALLING FIELD XPTPRM GETXY1= JMS I . /GET CO-ORDINATES X1 AND Y1 FROM CALLING FIELD POSTN1 GETXY2= JMS I . /GET CO-ORDINATES X2 AND Y2 FROM CALLING FIELD POSTN2 CHKXY1= JMS I . /CHECK POSITION OF X1 AND Y1 - RETURN WITH FLAGS XY1CHK DRWVEC= JMS I . /DRAW A VECTOR OR SHADE TO Y REFERENCE LINE FAREA= JMS I . /FILL AREA SPECIFIED WITH COLOR XAREA SENDIT= JMS I . /SEND COMMANDS TO GDC (ADDRESS FOLLOWS CALL) SENDAL DRAWIT= JMS I . /DRAW THE SPECIFIED FIGURE DRAW ERASE= JMS I . /ERASE THE SCREEN XERASE BLDPOS= JMS I . /BUILD A CURSOR POSITION STRING DOPOS SGNCHK= JMS I . /ADD TWO 12 BIT NUMBERS CHECKING FOR OVERFLOW XSGNCK DBLADD= JMS I . /DOUBLE PRECISSION SIGNED ADD TADD DBLSUB= JMS I . /DOUBLE PRECISSION SIGNED SUBTRACTION TSUB DBLMTY= JMS I . /DOUBLE PRECISSION SIGNED MULTIPLY TMPY DBLDIV= JMS I . /DOUBLE PRECISSION SIGNED DIVIDE TDIV CNVDBL= JMS I . /CONVERT SINGLE PRECISSION TO DOUBLE CDBLW MINMAX= JMS I . /CHECK VALUES TO BE WITHIN RANGE XMNMAX LDREG1= JMS I . /LOAD GRAPHICS REGISTER 1 WGREG1 LDREG2= JMS I . /LOAD GRAPHICS REGISTER 2 WGREG2 / K0007, 0007 K0010, 0010 K0012, 0012 K0017, 0017 K0077, 0077 K0177, 0177 K0377, 0377 M0001, -0001 M0004, -0004 M0010, -0010 / PTABLE, 0 /ADDRESS OF CALLING FIELDS PARAMETER TABLE / INITSZ= BEGIN-INDEX-1 /SIZE OF AREA TO INIT WHEN CALLED BY OPCODE "INIT" BEGIN, XPOS1, 0 /CURRENT HORIZONTAL POSITION IN PIXELS (0 - 799.) YPOS1, 0 /CURRENT VERTICAL POSITION IN PIXELS (0 - 239.) XFLAG1, 0 /POSITION OF X C0-ORDINATE TO SCREEN YFLAG1, 0 /POSITION OF Y CO-ORDINATE TO SCREEN XPOS2, 0 /TEMPORARY HORIZONTAL POSITION YPOS2, 0 /TEMPORARY VERTICAL POSITION XFLAG2, 0 /POSITION OF X CO-ORDINATE TO SCREEN YFLAG2, 0 /POSITION OF Y CO-ORDINATE TO SCREEN XTEMP1, 0 /SAVED "FROM" X CO-ORDINATE XTEMP2, 0 /SAVED "TO" X CO-ORDINATE PYPOS1, 0 /PHYSICAL Y POSITION 1 ON SCREEN LOGICAL/2 PYPOS2, 0 /PHYSICAL Y POSITION 2 ON SCREEN LOGICAL/2 LININD, 0 /USED TO INDICATE WHERABOUTS OF LINE DEGRES, 0 /# OF DEGREES IN A CIRCLE OR ARC REMAIN, 0 /USED IN CURVE FITTING SEG, 0 /USED IN CURVE FITTING DDCHAR, 0 /GRAPHIC DISPLAY CHARACTER MODX, 0 /MODULAR X MODY, 0 /MODULAR Y/2 / SLPDXH, 0 /DOUBLE PRECISION WORD FOR DELTAX (HIGH WORD) SLPDXL, 0 /LOW WORD SLPDYH, 0 /DOUBLE PRECISION WORD FOR DELTAY (HIGH WORD) SLPDYL, 0 /LOW WORD SLPOFS, 0 /INDICATES TYPE OF LINE AND DIRECTION OF SLOPE XDIF, 0 /INDICATES X TRAVERSING DIRECTION YDIF, 0 /INDICATES Y TRAVERSING DIRECTION /*/*/* WARNING - THIS TABLE MUST REMAIN IN THIS ORDER */*/*/ / MINX, SRNLHX /MINIMUM VALUE OF X CO-ORDINATE MAXX, SRNRHX /MAXIMUM VALUE OF X CO-ORDINATE +1 (800.) MINY, SRNUVY /MINIMUM VALUE OF Y CO-ORDINATE MAXY, SRNLVY /MAXIMUM VALUE OF Y CO-ORDINATE +1 (480.) / /*/*/*/ WARNING - WARNING DO NOT MOVE ORDER OF FOLLOWING LOCATIONS */*/*/*/ / WRITE OPTIONS GET SAVED AND RESTORED / TMPSIZ= YREF+1-FCOLOR SVRSTF, 0 /TEMP WRITE OPTION SAVE/RESTORE FLAG FCOLOR, 17 /CURRENT FOREGROUND COLOR (0 - 17 OCTAL) COLORM, 17 /COLOR PLANE MASK WORD (0 TO 17 OCTAL) LINTXT, 377 /LINE TEXTURE PATMLT, 1 /LINE PATTERN MULTIPLIER ARETXT, 0 /AREA TEXTURE ACHRST, 0 /AREA TEXTURE ALPHABET NEGFLG, 0 /NEGATIVE WRITING MODE FLAG WRMODE, 0 /WRITING MODE (0=OVERLAY, 1=REPLACE, 2=COMPLEMENT, / 3=ERASE) SHDFLG, 0 /SHADE FLAG 0=OFF 1=ON YREFLN, 0 /Y REFERENCE LINE USED FOR SHADING YREFLG, 0 /Y REFERENCE FLAG INDICATING LINES POSITION YREF, 0 /Y REFERENCE CLIPPED CO-ORDINATE / /*/*/* WARNING - DO NOT MOVE ORDER OF FOLLOWING LOCATIONS /*/*/* / TEXT OPTIONS GET SAVED AND RESTORED / QCHRST, 0 /ALPHABET SELECTED QCELRT, 0 /CELL ROTATION QCELHT, 0 /CELL HEIGHT QCELWD, 0 /CELL WIDTH QUNIHT, 0 /UNIT HEIGHT QUNIWD, 0 /UNIT WIDTH QCELIT, 0 /CELL ITALIC QCELFG, 0 /BASELINE ANGLE VS ABSOLUTE ESCAPEMENT FLAG QBASAN, 0 /BASELINE ANGLE QXESC, 0 /X CHARACTER ESCAPEMENT QYESC, 0 /Y CHARACTER ESCAPEMENT QXLFES, 0 /X LINE FEED ESCAPEMENT QYLFES, 0 /Y LINE FEED ESCAPEMENT QDOTSH, 0 /NUMBER OF DOTS IN CHARACTER HEIGHT QDOTSW, 0 /NUMBER OF DOTS IN CHARACTER WIDTH QDTHTC, 0 /NUMBER OF DOTS IN CELL HEIGHT (THAT FIT) QDTWDC, 0 /NUMBER OF DOTS IN CELL WIDTH (THAT FIT) QTXTDC, 0 /1X CHARACTER DOT WIDTH QTXTD, 0 /2X CHARACTER DOT HEIGHT TXTSXP, 0 /X TEXT REFERENCE STARTING POSITION TXTSYP, 0 /Y TEXT REFERENCE STARTING POSITION BCOLOR, 0 /CURRENT BACKGROUND COLOR (0 - 17 OCTAL) PRTBCL, 0 /BACKGROUND COLOR OF LAST SCREEN ERASE (SIXEL DUMPING) CLSCRV, 0 /INITIALIZE CLOSE CURVE TO FALSE INDEX, 0 /INITIALIZE INDEX/CURVE IN PROGRESS FLAG CURFLG, 1 /CURSOR FLAG TEMP, 0 /TEMPORARY VARIABLE FOR GENERAL USE / -------------------------------------------------------------------- / OLDFLD - CHANGE DATA FIELD TO FIELD WHICH CALLED GRAPHICS PRIMITIVES / -------------------------------------------------------------------- OLDFLD, 0 CDF 00 /THIS GETS MODIFIED JMP I OLDFLD /RETURN / / / ------------------- / ----- EQUATES ----- / ------------------- / IFNDEF CONDOR < AC0001= 7301 AC0002= 7305 AC0003= 7325 AC0004= 7307 AC0006= 7327 AC0010= 7315 AC0100= 7303 AC3777= 7350 AC4000= 7330 AC7775= 7346 AC7776= 7344 AC7777= 7340 > /END IFNDEF CONDOR IFDEF CONDOR < AC1= 7301 AC100= 7303 AC4K= 7330 ACNEG1= 7340 > /END IFDEF CONDOR / R3L= 7014 / GRDR= 6150 /GRAPHICS OPTION DMA READ GRDW= 6151 /GRAPHICS OPTION DMA WRITE GRGR= 6154 /GRAPHICS OPTION GDC READ GRGW= 6155 /GRAPHICS OPTION GDC WRITE GRW1= 6156 /GRAPHICS OPTION WRITE REGISTER ONE GRW2= 6157 /GRAPHICS OPTION WRITE REGISTER TWO / / ----- END EQUATES ----- *200 /EXECUTABLE CODE / ------------------------------------------------------------------------ / PRIMS - BEGINNING OF THE GRAPHIC PRIMITIVE SUBROUTINES / ------------------------------------------------------------------------ / / TAD (TABLE /ADDRESS OF PARAMETER TABLE / CIF PRGFLD /CHANGE I.F. TO GRAPHICS PRIMITIVES / JMS I (PRIMS /GO TO GRAPHIC PRIMITVE ROUTINE PRIMS, 0 DCA PTABLE /SAVE ADDRESS OF PARAMETER TABLE RDF /READ THE CALLING FIELDS DATA FIELD TAD KCDF /CREATE A CDF INSTRUCTION TO IT DCA OLDFLD+1 /SAVE THE CDF INSTRUCTION AC0002 /MAKE A CDF CIF INSTRUCTION TO CALLING FIELD TAD OLDFLD+1 / DCA CHGFLD /SAVE CIF CDF INSTRUCTION BACK TO CALLING FIELD TAD GRFX /CHECK IF OPTION BOARD PRESENT SNA CLA JMP CHGFLD /IF NOT, IGNORE THIS REQUEST GETPRM /GET THE OPERATION CODE FROM THE TABLE DCA OPCODE /SAVE THE OPERATION CODE CLA CLL TAD OPCODE /GET THE OPERATION CODE TAD LSTV0C /CHECK IT AGAINST LAST VALID OPERATION CODE SZL CLA /SKIP IF VALID JMP CHGFLD /UNIMPLEMENTED OPERATION CODE - EXIT TAD ADTBLE /GET THE ADDRESS OF THE DESPATCH TABLE TAD OPCODE /ADD OFFSET INTO TABLE DCA PRIMRT /SAVE THE TABLE ADDRESS CDF TBLFLD /TABLE FIELD FOR ADDRESS TAD I PRIMRT /GET THE ADDRESS TO DISPATCH TO CDF PRGFLD /BACK TO THIS FIELD DCA PRIMRT /SAVE THE DISPATCH ADDRESS JMS I CURSOR /GO TURN CURSOR OFF IF SET JMS I PRIMRT /GO TO GRAPHIC PRIMITIVE SUBROUTINE JMS I CURSOR /TURN THE CURSOR ON IF ENABLED CHGFLD, CIF!CDF 00 /CHANGE INSTRUCTION AND DATA FIELD TO CALLING FIELD CLA CLL /EXIT WITH AC AND LINK CLEARED JMP I PRIMS /RETURN TO CALLING FIELD PRIMRT, 0 /ADDRESS OF GRAPHIC SUBROUTINE TO BE EXECUTED KCDF, CDF 00 ADTBLE, DTABLE /ADDRESS OF DISPATCH TABLE ADDRESSES LSTV0C, DTABLE-EDTBLE-1 /# OF LAST VALID OPCODE IN TABLE CURSOR, XCURSR /ROUTINE TO TURN CURSOR ON OR OFF /---------------------------------------------------------------------------- / XGTPRM - GET A PARAMETER FROM THE CALLING FIELDS PARAMETER TABLE /----------------------------------------------------------------------------- XGTPRM, 0 CLA CLL JMS OLDFLD /CHANGE DATA FIELD TO CALLING FIELD TAD I PTABLE /GET THE PARAMETER CDF PRGFLD /CHANGE DATA FIELD BACK TO THIS FIELD ISZ PTABLE /UPDATE POINTER TO NEXT PARAMETER JMP I XGTPRM /RETURN WITH PARAMTER IN THE AC /------------------------------------------------------------------------------ / GTAREA - GET AREA PARAMETERS FROM CALLING FIELD + FILL AREA WITH SPECIFIED COLORL /------------------------------------------------------------------------------ / /GTAREA, 0 / GETXY1 /GET THE "FROM" X AND Y CO-ORDINATES / GETXY2 /GET THE "TO" X AND Y CO-ORDINATES / TAD SHDFLG /GET THE PRESENT SHADE FLAG / DCA GETVEC /SAVE IN TEMP / DCA SHDFLG /TURN SHADING OFF / FAREA /GO FILL AREA WITH PREVIOUSLY DEFINED COLOR / TAD GETVEC /GET THE SHADE FLAG SAVED / DCA SHDFLG /RESTORE ORIGINAL VALUE / JMP I GTAREA /RETURN /------------------------------------------------------------------------------ / POSTN2 - GET CO-ORDINATES X2 AND Y2 FROM THE CALLING FIELD /------------------------------------------------------------------------------ POSTN2, 0 GETPRM /GET THE "TO" X POSITION DCA XPOS2 /SAVE THE "TO" X POSITION GETPRM /GET THE "TO" Y POSITION DCA YPOS2 /SAVE THE "TO" Y POSITION JMP I POSTN2 / / ------------------------- / DMYSUB - DUMMY SUBROUTINE / ------------------------- / DMYSUB, 0 / JMP I DMYSUB /JUST RETURN / -------------------------------------------------------- / MORCOD - DISPATCH TO ANOTHER FIELD FOR OPCODE PROCESSING / -------------------------------------------------------- / MORCOD, 0 / CLA CLL TAD OPCODE /PASS OPCODE TO OTHER FIELD DCA MORCD4 TAD OLDFLD+1 /PASS ORIGINAL CALLING FIELD DCA MORCD5 TAD PTABLE /PASS ADDRESS OF CONTROL BLOCK DCA MORCD6 / CDF PRGFLD /ENSURE CURRENT DATA FIELD OK CIF TBLFLD /SET INSTRUCTION FIELD FOR MORE CODE JMS I PTPRIM /CALL OTHER FIELD FOR DISPATCH MORCD4, 0 / WITH OPCODE MORCD5, 0 / AND FIELD OF CONTROL BLOCK MORCD6, 0 / AND ADDRESS OF CONTROL BLOCK / CLA CLL JMP I MORCOD /RETURN / / PTPRIM, ZENTRY /** ENTRY POINT IN ANOTHER FIELD ** /------------------------------------------------------------------------------ / GTFGRD - GET THE FOREGROUND COLOR AND SWITCH BIT 0 WITH BIT 2 /------------------------------------------------------------------------------ / GTFGRD, 0 JMS I GTCOLR /GET FOREGROUND FROM CALLING FIELD FCOLOR JMP I GTFGRD /EXIT BACK TO CALLING FIELD /------------------------------------------------------------------------------- / GTBGRD - GET BACKGROUND COLOR AND SWITCH BIT 0 WITH BIT 2 /------------------------------------------------------------------------------- / GTBGRD, 0 JMS I GTCOLR /GET BACKGROUND COLOR FROM CALLING FIELD BCOLOR JMP I GTBGRD /EXIT BACK TO CALLING FIELD /------------------------------------------------------------------------------- / GTPLNS - GET COLOR PLANE MASK WORD AND SWITCH BIT 0 WITH BIT 2 /------------------------------------------------------------------------------ / GTPLNS, 0 JMS I GTCOLR /GET PLANE SELECT MASK WORD COLORM JMP I GTPLNS /EXIT BACK TO CALLING FIELD / GTCOLR, GTCPLN /ROUTINE TO GET COLOR PLANE AND SWITCH BITS / / ----------------------------------------------------------------------------- / POSTN1 - POSITION CURSOR - GET CO-ORDINATES X1 AND Y1 FROM CALLING FIELD / ----------------------------------------------------------------------------- / POSTN1, 0 GETPRM /GET THE NEW X POSITION DCA XPOS1 /SAVE THE NEW X POSITION GETPRM /GET THE NEW Y POSITION DCA YPOS1 /SAVE THE NEW Y POSITION JMP I POSTN1 /RETURN /--------------------------------------------------------------------------------- / SCRNER - SCREEN ERASE - FILL CLIPPING REGION WITH PREVIOUS SPECIFIED COLOR /------------------------------------------------------------------------------- SCRNER, 0 TAD BCOLOR /GET THE PRESENT BACKGROUND COLOR DCA PRTBCL /SAVE FOR SIXEL DUMPING OF SCREEN TAD WRMODE /GET THE PRESENT WRITING MODE DCA SAVWRM /SAVE IT IN CASE NOT OVERLAY MODE DCA WRMODE /SET WRITING MODE TO OVERLAY DCA SHDFLG /TURN SHADING OFF IF IT WAS ENABLED / SENDIT /FLASH MODE - SCREEN DISABLED SCRNOF / DRAWIT /FILL ENTIRE VISIBLE SCREEN WITH COLOR SHOME SSCRNE TXTPT1 / SENDIT /EXIT FLASH MODE SCREEN ENABLED SCRNON / TAD SAVWRM /GET THE SAVED WRITING MODE DCA WRMODE /RESTORE IT / JMP I SCRNER /EXIT / SAVWRM, 0 /SAVED WRITING MODE BEFORE ERASE SCREEN /----------------------------------------------------------------------------- / TRVLIN - CHECK IF LINE TRUE VERTICAL LINE WITH SHADING ON + COMP MODE /------------------------------------------------------------------------------ / TRVLIN, 0 TAD XTEMP1 /GET THE ORIGINAL FROM "X" CO-ORDINATE CIA /NEGATE IT TAD XPOS1 /CKECK IT AGAINST POSSIBLE CLIPPED CO-ORDINATE SZA CLA /SKIP IF THE SAME JMP NOTTVL /EXIT CALL+1 - NOT TRUE VERTICAL LINE TAD XTEMP2 /GET THE ORIGIANL TO "X" CO-ORDIANTE CIA /NEGATE IT TAD XPOS2 /CHECK IT AGAINST POSSIBLE CLIPPED CO-ORDINATE SNA CLA /EXIT CALL+1 - NOT TRUE VERTICAL LINE ISZ TRVLIN /EXIT CALL+2 - THIS LINE IS TRUELY VERTICAL NOTTVL, JMP I TRVLIN /EXIT BACK TO CALLER / / / -------------------------- / CHRPAT - CHARACTER PATTERN / -------------------------- / CHRPAT, ZBLOCK 0012 /TEN BYTES PAGE /------------------------------------------------------------------------------- / GTSHDO - TURN SHADING OFF /------------------------------------------------------------------------------ / GTSHDO, 0 DCA SHDFLG /CLEAR THE SHADE FLAG - ALL SHADING OFF DCA ARETXT /CLEAR AREA TEXTURE (SAFETY - NOT NEEDED) JMS I SUPDTP /RESET THE LINE PATTERN FOR DRAWING JMP I GTSHDO /RETURN BACK TO CALLER / SUPDTP, UPDPAT /------------------------------------------------------------------------------- / GETDRG - GET DISPLAY REGION PARAMETERS FROM THE CALLING FIELD /------------------------------------------------------------------------------- GETDRG, 0 GETPRM /GET THE LEFT HORIZONTAL X DCA MINX /SAVE IT GETPRM /GET THE UPPER VERTICAL Y DCA MINY /SAVE IT GETPRM /GET THE RIGHT HORIZONTAL X DCA MAXX /SAVE IT GETPRM /GET THE LOWER RIGHT VERTICAL Y DCA MAXY /SAVE IT / MINMAX /CHECK IF LEFT X DEFINED ON PHYSICAL SCREEN MINX /ADDRESS OF DATA TO BE CHECKED DRFLG1 /ADDRESS OF FLAG TO BE RETURNED DRLX /ADDRESS OF PHYSICAL SCREEN LEFT X DRRX /ADDRESS OF PHYSICAL SCREEN RIGHT X MINMAX /CHECK IF RIGHT X DEFINED ON PHYSICAL SCREEN MAXX /ADDRESS OF DATA TO BE CHECKED DRFLG2 /ADDRESS OF FLAG TO BE RETURNED DRLX /ADDRESS OF PHYSICAL SCREEN LEFT X DRRX /ADDRESS OF PHYSICAL SCREEN RIGHT X MINMAX /CHECK IF UPPER Y DEFINED ON PHYSICAL SCREEN MINY /ADDRESS OF DATA TO BE COMPARED DRFLG3 /ADDRESS OF DATA TO BE COMPARED DRUY /ADDRESS OF PHYSICAL SCREEN UPPER Y DRLY /ADDRESS OF PHYSICAL SCREEN LOWER Y MINMAX /CHECK IF LOWER Y DEFINED ON PHYSICAL SCREEN MAXY /ADDRESS OF DATA TO BE COMPARED DRFLG4 /ADDRESS OF FLAG TO BE RETURNED DRUY /ADDRESS OF PHYSICAL SCREEN UPPER LEFT DRLY /ADDRESS OF PHYSICAL SCREEN LOWER RIGHT TAD DRFLG1 /CHECK IF ALL CO-ORDINATES SPECIFED ON SCREEN TAD DRFLG2 / TAD DRFLG3 / TAD DRFLG4 / SZA CLA /SKIP IF ALL CO-ORDINATES ON SCREEN JMP DRDFLT /SPECIFIED CO-ORDINATE(S) NOT ON SCREEN TAD MAXX /CHECK IF MAXIMUM X > MINIMUM X SPECIFIED CIA TAD MINX SMA CLA /SKIP IF MAX X > MIN X JMP DRDFLT /MIN X >= MAX X TAD MAXY /CHECK IF MAXIMUM Y > MINIMUM Y SPECIFIED CIA TAD MINY SMA CLA /SKIP IF MAX Y > MIN Y JMP DRDFLT /MIN Y >= MAX Y ISZ MAXX /UPDATE X MAX TO PHYSICAL SCREEN +1 ISZ MAXY /UPDATE Y MAX TO PHYSICAL SCREEN +1 JMP DRCURP /GO INITIALIZE CURRENT POSITION TO LEFT TOP / DRDFLT, JMS DFLTRG /GO SETUP DEFAULT DISPLAY REGION / DRCURP, JMS HOMEPS JMP I GETDRG /EXIT - SCREEN REGION SETUP / DRFLG1, 0 DRFLG2, 0 DRFLG3, 0 DRFLG4, 0 / / /*/*/* WARNING THIS TABLE MUST REMAIN IN THIS ORDER */*/*/ / DRLX, SRNLHX /PHYSICAL SCREEN LEFT X CO-ORDINATE DRRX, SRNRHX /PHYSICAL SCREEN RIGHT X CO-ORDINATE+1 DRUY, SRNUVY /PHYSICAL SCREEN UPPER Y CO-ORDINATE DRLY, SRNLVY /PHYSICAL SCREEN LOWER Y CO-ORDINATE+1 / / ----------------------------------------- / DFLTRG - COPY DEFAULT SCREEN REGION / ----------------------------------------- / DFLTRG, 0 TAD M0004 /NUMBER OF WORDS TO BE MOVED JMS I DCOPY /COPY DEFAULT SCREEN REGION TO WORKING REGION DRLX-1 /ADDRESS -1 OF DATA TO BE MOVED MINX-1 /ADDRESS -1 OF WHERE DATA IS TO BE STORED JMP I DFLTRG /EXIT / DCOPY, COPDAT /MOVE DATA FROM A TO B / / -------------------------------------------- / HOMEPS - HOME CURSOR TO UPPER LEFT OF SCREEN / -------------------------------------------- / HOMEPS, 0 TAD MINX /REPOSITION CURSOR TO UPPER LEFT DCA XPOS1 / TAD MINY / DCA YPOS1 JMP I HOMEPS /EXIT /------------------------------------------------------------------------------- / INIT - INITIALIZE THE GRAPHIC MODULE AND GRAPHIC ROUTINES /------------------------------------------------------------------------------- INIT, 0 TAD SZINIT /GET THE SIZE OF MEMORY TO BE INITIALIZED DCA AUTO11 /SAVE THE COUNTER TAD INITBG /GET STARTING ADDRESS-1 OF INIT AREA DCA AUTO10 /SAVE ADDRESS-1 INITLP, DCA I AUTO10 /CLEAR THE WORD ISZ AUTO11 /DONE ? JMP INITLP /NO - CLEAR NEXT WORD JMS DFLTRG /SETUP DEFAULT SCREEN REGIONS ERASE /ERASE THE ENTIRE PHYSICAL SCREEN TO BLACK JMS HOMEPS /HOME THE CURSOR POSITION TO UPPER LEFT TAD K0017 /INITIALIZE FOREGROUND COLOR TO WHITE DCA FCOLOR / TAD K0017 /INITIALIZE COLOR MASK TO WRITE ALL PLANES DCA COLORM / TAD K0377 /INITIALIZE LINE TEXTURE DCA LINTXT / CLA CLL IAC /INITIALIZE LINE PATTERN MULTIPLIER DCA PATMLT / JMS I INITPT /INITIALIZE LINE PATTERN WORDS / CIF CDF TBLFLD /OTHER FIELD FOR INITIALIZATION JMS I XZINIT / AC1 /CLEAR ALPHABET ONE JMS I CSTCLR AC0002 /CLEAR ALPHABET TWO JMS I CSTCLR AC0003 /CLEAR ALPHABET THREE JMS I CSTCLR / JMP I INIT /RETURN BACK TO CALLER / SZINIT, INITSZ /SIZE OF AREA TO BE ZEROED INITBG, BEGIN-1 /STARTING ADDRESS-1 OF AREA TO BE CLEARED INITPT, UPDPAT /ROUTINE TO LOAD LINE PRAM'S WITH LINE TEXTURE CSTCLR, CLRCST /ROUTINE TO LOAD CHAR SET WITH ERROR CHAR'S XZINIT, ZINIT /ROUTINE TO INITIALIZE TABFLD CODE /----------------------------------------------------------------------------- / XY1CHK - CHECK POSITION IF XPOS1 AND YPOS1 - RETURN WITH FLAGS IN AC /------------------------------------------------------------------------------- / XY1CHK, 0 / MINMAX /CHECK IF STARTING X POSITION ON THE SCREEN XPOS1 XFLAG1 MINX MAXX / MINMAX /CHECK IF STARTING Y POSITION ON THE SCREEN YPOS1 YFLAG1 MINY MAXY / TAD XFLAG1 /CHECK IF STARTING POSITION ON SCREEN TAD YFLAG1 / JMP I XY1CHK /EXIT WITH STARTING POSITION FLAGS IN AC PAGE /----------------------------------------------------------------------------- / GETTXT - GET GRAPHIC TEXT CHAR AND POSITION - CHECK IF DISPLAYABLE /----------------------------------------------------------------------------- GETTXT, 0 / GETPRM /GET THE CHAR FROM CALLING FIELD DCA DDCHAR /SAVE IT FOR DISPLAYING JMS I ACKCHR /CHECK IF CHAR WITHIN ALPHABET EXTENT SNA CLA /SKIP IF NON-PRINTING CHAR JMP FITTXT /GO DRAW THE PRINTING CHARACTER TAD LEGCHR /GET ADDRESS -1 OF LEGAL CONTROL CHARS DCA AUTO10 /SAVE THE ADDRESS-1 TXTLUP, TAD I AUTO10 /CHECK IF TERMINATOR OF TABLE SNA /SKIP IF NOT TERMINATOR JMP TXTERR /CHAR NOT FOUND IN TABLE - SETUP ERROR CHAR TAD DDCHAR /ADD CHARACTER TO NEGATED TABLE CHARACTER SZA /SKIP IF COMPARISON ISZ AUTO10 /OTHERWISE UPDATE LOOKUP ADDRESS BY 1 SZA CLA /SKIP IF VALID COMPARE JMP TXTLUP /INVALID COMPARE - CHECK CHAR AGAINST NEXT TAD I AUTO10 /GET THE CHAR FUNCTION DISPATCH ADDRESS DCA GTCRA /SAVE THE DISPATCH ADDRESS JMS I GTCRA /GO DO THE CHAR FUNCTION IMPLIED JMP NOTEXT /EXIT - CHAR WAS CR, LF, BS, HT TXTERR, TAD K0177 /GET THE ERROR CHARACTER DCA DDCHAR /SAVE IT FOR DISPLAY / FITTXT, CDF TBLFLD /CHANGE FIELD FOR DATA TAD XPOS1 /GET CURRENT POSITION TAD I XDELX /ADD WIDTH-1 OF CHAR DCA XPOS2 /SAVE FOR 'WILL'IT FIT' TEST TAD YPOS1 /GET CURRENT POSITION TAD I XDELY /ADD HEIGHT-2 OF CHAR DCA YPOS2 /SAVE FOR 'WILL IT FIT' TEST CDF PRGFLD /BACK TO THIS FIELD / JMS I XXCHKC /CHECK IF CHARACTER FITS ENTIRELY ON SCREEN JMP GETTX6 /YES, CONTINUE WITH THE CHARACTER JMP GETTX8 /NO, JUST MOVE A SPACE JMP GETTX8 /NO, JUST MOVE A SPACE / GETTX6, CIF TBLFLD /AUXILIARY FIELD FOR ROUTINE JMS I XXSAVM /SAVE WRITING, NEGATE, SHADE MODES DCA SHDFLG /TURN SHADING OFF / JMS I XSPDTX /DRAW CHARACTER CELL IF OK TO DO SO / JMS I XDTEXT /GO DRAW THE GRAPHIC CHARACTER JMS I XCURRS /RESTORE ORIGINAL CURSOR POSITION CIF TBLFLD /AUXILIARY FIELD FOR ROUTINE JMS I XXRESM /RESTORE WRITING, NEGATE, SHADE MODES / GETTX8, JMS I XFSPAC /POSITION CURSOR ONE SPACE FORWARD / NOTEXT, JMP I GETTXT /RETURN BACK TO CALLER / XDTEXT, DTEXT XCURRS, CURRST XFSPAC, FSPACE LEGCHR, CHRLEG-1 ACKCHR, CHKCHR XSPDTX, SPDTXT GTCRA, 0 XDELX, DELX XDELY, DELY XXCHKC, CHKCLP XXSAVM, SAVMOD XXRESM, RESMOD /------------------------------------------------------------------------------- / SETUP - HANDLE SETUP PARAMETERS /------------------------------------------------------------------------------- / / THE ARGUMENT BITS INDICATE STATES: / AC<11> 1=CURSOR ENABLED, 0=CURSOR DISABLED / AC<10> 1=GRAPHICS ON MONOCHROME MONITOR, 0=NO / AC<09> 1=TEXT ON COLOR MONITOR, 0=NO TEXT ON COLOR MONITOR / AC<08> 1=DISABLE GRAPHICS, 0=ENABLE GRAPHICS / AC<07> 1=DISABLE TEXT, 0=ENABLE TEXT / AC<06> 1=RESYNCH VIDEOS, 0=DON'T BOTHER / SETUP, 0 GETPRM /GET SETUP PARAMETER FROM CALLING FIELD DCA SETUPW /SAVE ARGUMENT / AC1 /CHECK IF GRAPHICS CURSOR ENABLED AND SETUPW SNA CLA /CHECK IF CURSOR ENABLED AC1 /IF SO, MAKE A ONE, ELSE MAKE A ZERO DCA CURFLG /SAVE IN CURSOR FLAG / TAD GOBTYP /CHECK TYPE OF GRAPHICS BOARD TO HANDLE SNA CLA / MONITOR CONFIGURATION JMP SETUP1 /GO HANDLE OLD BOARD / CIF TBLFLD /NEW BOARD, CALL ROUTINE IN OTHER FIELD JMS I XDM3ST / TO HANDLE MONITOR CONFIGURATION / JMP SETU1D /GO CONTINUE WITH SETUP / /OLD GRAPHICS BOARD SETUP1, AC0002 /CHECK IF GRAPHICS ON MONOCHROME MONITOR AND SETUPW SZA CLA TAD K1000S /YES, SET UP FOR REG11 = 5000 TAD K4000 / OR IF NOT, REG11 = 4000 DCA REG1HI /SAVE FOR LATER USE / AC0004 /CHECK IF TEXT ON COLOR MONITOR AND SETUPW SZA CLA TAD K4210 /IF SO, READY TO MAKE A 7777 TAD K3567 / OR IF NOT, MAKE A 3567 DCA SETUP6 /SAVE INLINE FOR LATER EXECUTION LDREG2 /WRITE TO REGISTER TWO TO HANDLE TEXT DEST SETUP6, 0 /REG 2 VALUE (MODIFIED IN CODE) / SETU1D, AC0010 /CHECK IF GRAPHICS DISABLED AND SETUPW SZA CLA JMP SETUP2 /YES, GO DISABLE GRAPHICS SENDIT /NO, ENABLE GRAPHICS SCRNON JMP SETUP4 SETUP2, SENDIT SCRNOF / SETUP4, TAD KKK20 /CHECK IF TEXT DISABLED AND SETUPW SZA CLA AC1 /YES, READY TO DISABLE TEXT PR3 / OR ENABLE TEXT VIA THIS PRQ 0001 / TO TELL SLUSHWARE ABOUT 7777 / VIDEO VISIBILITY / LDREG1 /WRITE TO REGISTER ONE 71 / TO HANDLE GRAPHICS DESTINATION / / TAD KKK40 /CHECK IF RESYNCHRONIZATION REQUIRED AND SETUPW SNA CLA JMP SETUP8 /IF NOT, JUST GO RETURN JMS I XSYNCH /IF SO, GO DO IT / SETUP8, JMP I SETUP /EXIT - CURSOR,GRAPHIC AND TEXT SCREEN SELECTED / / SETUPW, 0 K4000, 4000 K1000S, 1000 K3567, 3567 K4210, 4210 KKK20, 0020 KKK40, 0040 XSYNCH, SYNCH XDM3ST, DM3SET PAGE /------------------------------------------------------------------------------ / UPDPAT - COPY OR REPLICATE BYTE TO TWO WORDS DEPENDENT ON MULTIPLIER /------------------------------------------------------------------------------- / UPDPAT, 0 TAD LPATAD /GET ADDRESS OF GDC LINE PATTERN DCA UPDTMP /SAVE THE ADDRESS AS WORKING ADDRESS CLA CLL CMA /CHECK PATTERN MULTIPLIER TAD PATMLT / SZA CLA /WAS IT A ONE ? JMP PATDBL /NO - GO REPLICATE THE PATTERN TO TWO WORDS TAD LINTXT /GET THE LINE TEXTURE DCA I UPDTMP /SAVE THE FIRST BYTE ISZ UPDTMP /UPDATE POINTER TO 2ND BYTE TAD LINTXT /GET THE BASE LINE TEXTURE DCA I UPDTMP /SAVE THE SECOND BYE AS SAME AS FIRST JMP I UPDPAT /RETURN BACK TO CALLER / PATDBL, CLA CLL CMA RAL /-2 DCA UPDCN1 /TWO WORD BYTE COUNTER TAD LINTXT /GET THE BASE LINE TEXTURE DCA LINTMP /SAVE AS WORKING LINE PATTERN UPDLP1, TAD M0004 /SETUP 4 BIT TO 8 BIT COUNT DCA UPDCN2 /SAVE COUNTER UPDLP2, DCA I UPDTMP /SAVE NEW 8 BIT PATTERN TAD LINTMP /GET THE WORKING PATTERN CLL RAR /BUT LEAST SIGNIFICANT BIT INTO LINK DCA LINTMP /SAVE THE NEW WORKING PATTERN TAD I UPDTMP /GET THE NEW 8 BIT PATTERN RAR /MOVE LINK INTO SIGN BIT SPA /CHECK IF SIGN BIT SET CML /YES REPLICATE A 1 INTO SIGN BIT RAR /INITIAL PATTERN NOW REPLICATED ISZ UPDCN2 /DONE ALL 4 BITS JMP UPDLP2 /NO - DO NEXT BIT CLL RTR /MOVE PATTERN INTO LEAST SIGNIFICANT 8 CLL RTR / DCA I UPDTMP /SAVE THIS AS NEW PATTERN WORD ISZ UPDTMP /UPDATE ADDRESS TO NEXT PATTERN WORD ISZ UPDCN1 /DONE BOTH WORDS ? JMP UPDLP1 /NO - GO DO SECOND WORD OF PATTERN JMP I UPDPAT /EXIT BACK TO CALLER / LPATAD, LINPAT+1 /ADDRESS OF GDC LINE PATTERN UPDTMP, 0 /POINTER TO GDC 2 WORD LINE PATTERN UPDCN1, 0 /USED TO COUNT THE TWO WORDS UPDCN2, 0 /USED TO COUNT THE? BIT TO 8 BIT REPLICATION LINTMP, 0 /WORKING LINE PATTERN / /------------------------------------------------------------------------------ / TEXT CARRIAGE RETURN ROUTINE /------------------------------------------------------------------------------- / CARGRT, 0 TAD TXTSXP /GET STARTING X POSITION OF PRESENT LINE DCA XPOS1 /SAVE AS CURRENT X TAD TXTSYP /GET STARTING Y POSITION OF PRESENT LINE DCA YPOS1 /SAVE AS CURRENT Y JMP I CARGRT /EXIT - CARRAIGE RETURN FUNCTION PERFORMED /------------------------------------------------------------------------------ / TEXT BACKSPACE ROUTINE /------------------------------------------------------------------------------ / BACKSP, 0 TAD QXESC /GET THE X ESCAPEMENT CIA /NEGATE IT JMS UPDATX /GO UPDATE THE CURRENT X POSITION TAD QYESC /GET THE Y ESCAPEMENT CIA /NEGATE IT JMS UPDATY /GO UPDATE THE CURRENT Y POSITION JMP I BACKSP /EXIT - BACKSPACE FUNCTION PERFORMED /----------------------------------------------------------------------------- / TEXT LINEFEED ROUTINE /----------------------------------------------------------------------------- / LNFEED, 0 TAD QXLFES /GET THE X LF ESCAPEMENT JMS UPDATX /UPDATE CURRENT X POSITION TAD QYLFES /GET THE Y LF ESCAPEMENT JMS UPDATY /UPDATE CURRENT Y POSITION TAD QXLFES /GET THE X LF ESCAPEMENT SGNCHK /GO ADD/SUB IT FROM STARTING X POSITION TXTSXP /ADDRESS OF SECOND WORD TO ADD DCA TXTSXP /SACE THE UPDATED X TEXT STARTING POSITION TAD QYLFES /GET THE Y LF ESCAPEMENT SGNCHK /GO ADD/SUB IT FROM STARTING Y POSITION TXTSYP /ADDRESS OF SECOND WORD TO ADD DCA TXTSYP /SAVE THE UPDATED Y TEXT STARTING POSITION JMP I LNFEED /EXIT / ----------------------------------------- / UPDATX - UPDATE X POSITION BY VALUE IN AC / ----------------------------------------- / UPDATX, 0 SGNCHK /GO ADD/SUB IT FROM THE CURRENT X POSITION XPOS1 /ADDRESS OF SECOND WORD TO ADD DCA XPOS1 /SAVE THE RESULT AS NEW X POSITION JMP I UPDATX / / ----------------------------------------- / UPDATY - UPDATE Y POSITION BY VALUE IN AC / ----------------------------------------- UPDATY, 0 SGNCHK /GO ADD/SUB IT FROM THE CURRENT Y POSITION YPOS1 /ADDRESS OF SECOND WORD TO ADD DCA YPOS1 /SAVE THE RESULT AS NEW Y POSITION JMP I UPDATY / / --------------------------------------- /LOOKUP TABLE FOR SPECIAL TEXT CHARACTERS / --------------------------------------- / CHRLEG, -15 /NEGATED CARRAIGE RETURN CARGRT /CARRAIGE ROUTINE ADDRESS -12 /NEGATED LINEFEED LNFEED /LINEFEED ROUTINE ADDRESS -10 /NEGATED BACKSPACE BACKSP /BACKSPACE ROUTINE ADDRESS -11 /NEGATED HORIZONTAL TAB FSPACE /FORWARD SPACE (NON-PRINTING) 0 /TERMINATOR / ----------------------------------- / FSPACE - NON-PRINTING FORWARD SPACE / ----------------------------------- / FSPACE, 0 / TAD QXESC /GET THE X ESCAPEMENT BETWEEN CHARACTERS JMS UPDATX /GO UPDATE CURRENT X POSITION TAD QYESC /GET THE Y ESCAPEMENT BETWEEN CHARACTERS JMS UPDATY /GO UPDATE CURRENT Y POSITION / JMP I FSPACE /RETURN / ---------------------------------------- / STCHAR - START CHARACTER PRECOMPUTATIONS / ---------------------------------------- / STCHAR, 0 / CLA CLL TAD QCHRST /GET ADDRESS OF CHARACTER IN PANEL RAM JMS I XGETAD DCA STCHA2 /SAVE FOR BLOCK MOVE TO USER MEMORY / PR3 /BLOCK MOVE PANEL-TO-USER 5000+PRGFLD+PBMFLD STCHA2, 0 /BECOMES ADDRESS IN PANEL MEMORY CHRPAT -0012 7777 / JMS I XSAVCU /SAVE CURRENT POSITION / TAD M0010 /CHECK IF HEIGHT SO SMALL THAT HALF-HEIGHT TAD QDOTSH / CHARACTERS ARE NEEDED SMA CLA JMP STCHA4 /NO, GO CHECK WIDTH CIF CDF TBLFLD /YES, GO TO OTHER FIELD JMS I XBYTCM / TO COMBINE BYTES / STCHA4, TAD M0010 /CHECK IF WIDTH SO SMALL THAT HALF-WIDTH TAD QDOTSW / CHARACTERS ARE NEEDED SMA CLA JMP STCHA6 /NO, GO RETURN CIF CDF TBLFLD /YES, GO TO OTHER FIELD JMS I XBITCM / TO COMBINE BITS / STCHA6, JMP I STCHAR /RETURN / / XGETAD, GETADR XSAVCU, SAVCUR XBYTCM, BYTCMB XBITCM, BITCMB / / /---------------------------------------------------------------------------- / GET VECTOR PARAMETERS FROM CALLING FIELD AND DRAW THE VECTOR /------------------------------------------------------------------------------ GETVEC, 0 GETXY2 /GET THE "TO" X AND Y CO-ORDINATES DRWVEC /DRAW THE VECTOR JMP I GETVEC /EXIT PAGE / --------------------------- / DTEXT - DISPLAY A CHARACTER / --------------------------- / DTEXT, 0 / JMS I XSTCHA /DO SOME PRE-COMPUTATION FOR THIS CHARACTER / TAD QDTHTC /GET NUMBER OF DOTS HIGH CIA /COMPLEMENT FOR LOOP CONTROL DCA QDTHCT /SAVE FOR LOOP COUNTER / TAD PCHRPT /SET UP POINTER TO CHARACTER DATA DCA DTEXTM / /PREBUILD PART OF FIGS FOR THIS CHARACTER TAD K0020 /BUILD P1, AREA FILL TAD QCELRT / AND CELL ROTATION DCA I PSTXT1 / PUT INTO FIGS STRING / DTEXT3, TAD XPOS1 /SAVE START OF THIS ROW OF DOTS DCA XPOS2 TAD YPOS1 DCA YPOS2 / JMS I XSTROW /BUILD PART OF FIGS STRING FOR THIS ROW / TAD QDTWDC /GET NUMBER OF DOTS WIDE CIA /NEGATE FOR LOOP CONTROL DCA DTXTM4 /SAVE FOR CONTROL / OF CUMULATIVE DOTS WRITTEN ON A LINE / TAD I DTEXTM /DETERMINE SENSE OF FIRST 'DOT CLL RAR / BY ROTATING INTO LINK DCA I DTEXTM / SAVE ROTATED PATTERN RAR / AND MOVE BIT INTO SIGN DCA DTXTM5 / SAVE SENSE OF 'PREVIOUS SENSE FLAG' DTEXT5, BLDPOS /CREATE CURSOR POSITION STRING FOR THESE DOTS SPOSIT / TAD I DTEXTM /CHECK IF ONLY ZERO DOTS LEFT TAD DTXTM5 / AND THAT'S WHAT WE'RE COLLECTING SNA CLA JMP DTXT10 /YES, GO DRAW TO CELL APRON / DCA DTXTM3 /ASSUME NO DOTS-IN-A-ROW YET / DTXT5D, CDF TBLFLD /SET UP TO GET DATA FROM TABLE FIELD TAD I QKXW /GET X MOTION PER COLUMN TAD XPOS1 / AND ADD IT TO X POSITION DCA XPOS1 TAD I QKYW /GET Y MOTION PER COLUMN TAD YPOS1 / AND ADD IT TO Y DCA YPOS1 CDF PRGFLD /BACK TO THIS FIELD / ISZ DTXTM3 /INCREMENT COUNT OF DOTS / TAD I DTEXTM /GET A DOT TO CHECK CLL RAR / INTO LINK DCA I DTEXTM /SAVE ROTATED PATTERN RAR /ROTATE DOT INTO SIGN BIT TAD DTXTM5 /COMPARE WITH PREVIOUS SENSE SPA CLA /TWO +'S OR TWO -'S YIELD + RESULT HERE JMP DTXT5E /DOTS DON'T MATCH, GO DRAW WHAT WE HAVE / TAD DTXTM3 /CHECK IF CURRENT DOT COUNT TAD DTXTM4 / AND THE DOTS ALREADY DRAWN SPA CLA / ARE ALL THE DOTS THERE ARE JMP DTXT5D /IF NOT DONE, GO BACK TO DO SOME MORE /HAVE ACCUMULATED LIKE DOTS DTXT5E, TAD DTXTM5 /CHECK SENSE OF 'DOTS' TO BE DRAWN SPA CLA / (SIGN BIT ON -> DOTS ON) TAD PTXPT1 /POINT TO PRAM FOR ON BIT TAD PTXPT0 /POINT TO PRAM STRING FOR OFF BIT DCA DTEXT7 /SAVE POINTER FOR 'DRAW' CALL / TAD DTXTM5 /CHECK SENSE OF 'DOTS' TO BE DRAWN SPA CLA / TO SEE IF WE CAN SKIP DRAWING JMP DTXT5B /BIT ON TAD I XSKIP0 /BIT OFF, CHECK THE ZERO BIT SKIP FLAG SKP /GO TEST THE SKIP FALG DTXT5B, TAD I XSKIP1 /BIT ON, CHECK THE ONE BIT SKIP FLAG SZA CLA /CHECK THE APPROPRIATE SKIP FLAG JMP DTXT7B /NO NEED TO DRAW THIS DOT / /THIS DOT WILL SHOW, MUST DRAW IT TAD PSTXDC /COMPLETE THE FIGS STRING FOR THIS DOT DCA AUTO10 /POINT TO THE TEXT FIGS STRING / TAD DTXTM3 /GET NUMBER OF DOTS ACROSS CIA / FOR CONTROL OF ADD COUNTER (MULTIPLY) DCA TEMP / DTXT5F, TAD QTXTDC /ADD WIDTH OF DOT ISZ TEMP /LOOP ON ADD UNTIL PRODUCT GENERATED JMP DTXT5F TAD M0001 /(-1 FOR GDC DC PARAMETER) JMS I XXSAVD /SAVE PRODUCT AS FIGS DC PARAMETER / DRAWIT /DRAW SOMETHING SPOSIT / AT THIS POSITION PSTEXT, STEXT / WITH FIGS/GCHRD FOR AREA FILL DTEXT7, 0 / WITH THESE PARAMETERS (MODIFIED IN CODE) / DTXT7B, AC4K /INVERT SENSE OF DOT TO MATCH TAD DTXTM5 / BY INVERTING SIGN BIT DCA DTXTM5 / TAD DTXTM3 /KEEP TRACK OF ALL DOTS WRITTEN TAD DTXTM4 DCA DTXTM4 / TAD DTXTM4 /CHECK IF DONE ALL DOTS IN THIS ROW SPA CLA JMP DTEXT5 /NOT YET, GO DO SOME MORE / DTXT10, JMS I XTXTAP /GO DRAW TO END OF ROW IN CELL / CDF TBLFLD /SET UP TO GET DATA FROM TABLE FIELD TAD I QKXH /GET X MOTION PER ROW TAD XPOS2 / AND ADD IT TO X POSITION OF LAST ROW START DCA XPOS1 TAD I QKYH /GET Y MOTION PER ROW TAD YPOS2 / AND ADD IT TO Y DCA YPOS1 CDF PRGFLD /BACK TO THIS FIELD / ISZ DTEXTM /INCREMENT POINTER TO CHARACTER BYTES / ISZ QDTHCT /INCREMENT THROUGH ROW DOTS JMP DTEXT3 / UNTIL ALL COLUMNS DONE / JMP I DTEXT /RETURN / / K0020, 0020 DTEXTM, 0 DTXTM3, 0 DTXTM4, 0 DTXTM5, 0 QDTHCT, 0 XXSAVD, SAVEDX XSTCHA, STCHAR XTXTAP, TXTAPR PSTXDC, STEXT+1 PTXPT0, TXTPT0 PTXPT1, TXTPT1-TXTPT0 PCHRPT, CHRPAT QKXW, ZXKI QKXH, ZXKJ QKYW, ZYKI QKYH, ZYKJ XSKIP0, SKIP0 XSKIP1, SKIP1 PSTXT1, STEXT+1 XSTROW, STROW PAGE /------------------------------------------------------------------------------- / GTSHDY - ENABLE SHADING TO Y - SET Y REFERENCE LINE /------------------------------------------------------------------------------ / GTSHDY, 0 CLA CLL IAC /GET INDICATOR FOR SHADE TO Y DCA SHDFLG /SAVE INDICATOR GETPRM /GET THE Y REFERENCE LINE FROM CALLER DCA YREFLN /SAVE IT MINMAX /GO CHECK WHERABOUTS OF LINE ON SCREEN YREFLN /ADDRESS OF LINE TO CHECK YREFLG /ADDRESS OF FLAG MINY /ADDRESS OF MINIMUM ALLOWED MAXY /ADDRESS OF MAX+1 ALLOWED TAD YREFLG /GET THE Y REFERENCE FLAG SNA /SKIP IF Y REFERENCE ON THE SCREEN JMP SHDY2 /GO SETUP WORKING Y REFERENCE IAC /CHECK IF Y REF AFTER SCREEN SZA CLA /SKIP IF AFTER JMP SHDY1 /NO - Y REF IS BEFORE THE SCREEN CLA CLL CMA /SETUP TO GET MAXY-1 TAD MAXY /MAX Y CO-ORDINATE ALLOWED SKP SHDY1, TAD MINY /MINIMUM Y ALLOWED SKP SHDY2, TAD YREFLN /ACTUAL Y REFERNECE DCA YREF /SAVE AS NEW Y REFERNECE GETPRM /GET SHADE CHARACTER IF ANY FROM CALLING FIELD AND K0377 /MASK TO 8 BITS DCA ARETXT /SAVE AS SHADE CHAR IF NOT 0 TAD QCHRST /GET THE CURRENLY SELECTED ALPHABET DCA ACHRST /SAVE IT - TO GET THE SHADE CHAR IF SELECTED JMS I XSHDTX /GO SETUP FOR AREA SHADING WITH LINE OR CHAR JMP I GTSHDY /RETURN BACK TO THE CALLER / XSHDTX, GTATXT /------------------------------------------------------------------------------- / RETREG - RETURN TO CALLER THE CO-ORDINATES OF THE LOGICAL SCREEN /------------------------------------------------------------------------------- / RETREG, 0 TAD M0004 /SETUP TO RETURN 4 VALUES JMS MOVEIT /GO MOVE 4 PARAMETERS LREGIN /ADDRESS OF DATA TO BE MOVED JMP I RETREG /EXIT /------------------------------------------------------------------------------ / RETPOS - RETURN CO-ORDINATES OF THE CURRENT CURSOR POSITION /------------------------------------------------------------------------------ / RETPOS, 0 CLA CLL CMA RAL /-2 JMS MOVEIT /GO MOVE 2 PARAMETERS TO CALLER XPOS1 /FROM XPOS1 AND YPOS1 LOCATION JMP I RETPOS /------------------------------------------------------------------------------ / XPTPRM - STORE PARAMETER INTO CALLING FIELD AND UPDATE CALLING FIELDS POINTER /------------------------------------------------------------------------------ / XPTPRM, 0 JMS OLDFLD /CHANGE DATA FIELD TO CALLING FIELD DCA I PTABLE /GIVE PARAMETER TO CLLING FIELD CDF PRGFLD /RESTORE THIS FIELDS DATA FIELD ISZ PTABLE /UPDATE CALLING FIELDS POINTER JMP I XPTPRM /EXIT /------------------------------------------------------------------------------ / MOVEIT - RETURN VALUES BACK TO CALLING FIELD /------------------------------------------------------------------------------ / MOVEIT, 0 DCA MOVCNT /SAVE THE NUMBER OF PARAMETERS TO MOVE TAD I MOVEIT /GET THE ADDRESS OF PARAMETERS TO MOVE DCA MOVPNT /SAVE THE POINTER ISZ MOVEIT /BUMP POINTER FOR RETURN MOVLOP, TAD I MOVPNT /GET THE PARAMETER PUTPRM /STORE PARAMETER IN CALLING FIELD ISZ MOVPNT /UPDATE THIS FIELDS POINTER ISZ MOVCNT /DONE ? JMP MOVLOP /NO - MOVE NEXT PARAMETER INTO CALLING FIELD JMP I MOVEIT /RETURN BACK TO CALLER / MOVCNT, 0 MOVPNT, 0 /------------------------------------------------------------------------------ / CLRCST - LOAD SPECIFIED CHARACTER SET WITH ERROR CHARACTER (96 CHARACTERS) /------------------------------------------------------------------------------ / CLRCST, 0 SNA /SKIP IF NOT US ASCII CHAR SET JMP I CLRCST /EXIT - CAN NOT CLEAR US ASCII CHAR SET DCA CSCLR /SAVE THE CHAR SET TO BE CLEARED TAD K40CS /INITIALIZE THE STARTING CHARACTER TO 40 DCA DDCHAR TAD M140 /SETUP COUNTER TO LOAD 96 CHARACTERS DCA CSCNT1 /SAVE CHARACTER SET COUNTER CLRCS1, TAD CSCLR /GET THE CHARACTER SET TO BE CLEARED JMS I XGTADR /GET THE BASE ADDRESS OF CHAR SET TO BE INIT'ED DCA CLRCS2 /SAVE THE BASE ADDRESS PR3 /BLOCK MOVE FROM THIS FIELD TO PANEL RAM PBMFLD+4000+PRGFLD / FIELD REF FIX FOR WPS /C055A CHARER /ADDRESS IN THIS FIELD OF DATA TO BE MOVED CLRCS2, 0 /PANEL RAM ADDRESS - WHERE TO STORE ERROR CHAR -12 /NUMBER OF WORDS TO BE MOVED 7777 /TERMINATOR ISZ DDCHAR /UPDATE THE CHARACTER BY 1 ISZ CSCNT1 /DONE FILLING CHARACTER SET ? JMP CLRCS1 /NO - CLEAR NEXT GRAPHIC CHARACTER JMP I CLRCST /EXIT - THE SPECIFIED CHAR SET NOW CLEARED / XGTADR, GETADR CSCLR, 0 CSCNT1, 0 M140, -140 K40CS, 40 CHARER, 377; 377; 377; 377; 377; 377; 377; 377; 377; 377 /------------------------------------------------------------------------------- / GTCPLN - EXCHANGE BITS 0 AND 2 IN THE COLOR PLANE AND PLANE MASK WORDS /------------------------------------------------------------------------------ / GTCPLN, 0 TAD I GTCPLN /GET THE ADDRESS OF WORD TO BE MODIFIED DCA CPLNAD /SAVE THE ADDRESS ISZ GTCPLN /UPDATE THE RETURN POINTER GETPRM /GET COLOR PLANE SELECTION FROM CALLING FIELD DCA I CPLNAD /SAVE THE SPECIFIED COLOR PLANE TAD I CPLNAD /GET THE COLOR PLANE SELECTION AND C7760 /CHECK TO SEE IF OUT GREATER THEN 17 SZA CLA /SKIP IF LESS THEN 17 TAD K0017 /GREATER THEN 17 - DEFAULT TO ALL PLANES ON SZA DCA I CPLNAD /SAVE THE DEFAULT COLOR PLANE SELECTION AC1 /MASK OUT BIT<11> AND I CPLNAD / OF THE COLOR OR PLANE MASK WORD CLL RTL /PUT IT IN BIT 2 DCA XCHGTM /SAVE IN TEMP AC0004 /MASK TO BIT<09> AND I CPLNAD / OF THE COLOR OR PLANE MASK WORD RTR /PUT BIT 2 INTO BIT 0 TAD XCHGTM /ADD PREVIOUSLY SWAPPED BIT TO IT DCA XCHGTM /SAVE SWAPPED VALUE TAD I CPLNAD /GET THE INITIAL WORD AND K0012 /KEEP INTINSITY AND RED PLANE TAD XCHGTM /ADD THE SWAPPED BITS BACK INTO WORD DCA I CPLNAD /SAVE THE NEW VALUE WITH THE SWAPPED BITS JMP I GTCPLN /EXIT BACK TO CALLER / CPLNAD, 0 XCHGTM, 0 C7760, 7760 PAGE /------------------------------------------------------------------------------ / GTCSIZ - CLEAR SPECIFIED ALPHABET BIT-MAP /-------------------------------------------------------------------------------- / GTCSIZ, 0 GETPRM /GET SPECIFIED ALPHABET FROM CALLING FIELD SNA SPA /SKIP IF ALPHABET >0 JMP GTCSZE /EXIT - LESS THEN OR EQUAL TO ZERO DCA CSIZAB /SAVE THE SPECIFIED ALPHABET CLA CLL CMA RTL /-3 TAD CSIZAB /GET THE SPECIFIED ALPHABET SMA SZA CLA /SKIP IF ALPHABET SPECIFIED = 1, 2 OR 3 JMP GTCSZE /EXIT - ALPHABET SELECTED OUT OF RANGE TAD CSIZAB /GET THE SPECIFIED ALPHABET JMS I SIZCLR /GO LOAD SPECIFED ALPHABET WITH ERROR BIT MAP GTCSZE, CLA CLL JMP I GTCSIZ /EXIT BACK TO CALLING FIELD / SIZCLR, CLRCST /ROUTINE TO LOAD CHAR SET WITH ERROR BIT MAP CSIZAB, 0 CSIZFG, 0 / / / ---------------------------------------- / SSCRNE - COMMAND STRING FOR SCREEN ERASE / ---------------------------------------- / SSCRNE, 514; 020; 037; 003; 360; 000; 360; 000 550 7777 /------------------------------------------------------------------------------ / GTTXTR - GET TEXT REFERENCE POSITION FOR CARRAIGE RETURN AND LINE FEEDS /------------------------------------------------------------------------------- / GTTXTR, 0 TAD XPOS1 /GET THE CURRENT X POSITION DCA TXTSXP /SAVE IT TAD YPOS1 /GET THE CURRENT Y POSITION DCA TXTSYP /SAVE IT / ACNEG1 /CHECK IF REPLACE, NON-ITALIC, NON-NEGATE TAD WRMODE / TO SKIP ZERO DOTS, CAUSE SZA CLA / THEY ARE HANDLED BY SPECIAL CODE JMP GTTXT2 /NOT REPLACE, GO DO NORMAL STUFF HERE TAD QCELIT /IS REPLACE, CHECK ALSO FOR NON-ITALIC SZA CLA JMP GTTXT2 /ITALIC, GO DO NORMAL STUFF TAD NEGFLG /REPLACE, NON-ITALIC, CHECK FOR NON-NEGATE SNA CLA JMP GTTXT3 /AHA! SKIP ZEROES / GTTXT2, TAD NEGFLG /CHECK IF ZERO DOTS CAN BE IGNORED SZA CLA / CAN IGNORE, IF W(N0,V) OR W(N0,C) JMP GTTXT4 /NEGATE ON, MUST DRAW AC1 /NEGATE OFF, CHECK WRITING MODE AND WRMODE / FOR OVERLAY OR COMPLEMENT (LSB SET) SNA CLA GTTXT3, ACNEG1 /CAN IGNORE ZEROES GTTXT4, DCA SKIP0 /MARK FLAG / TAD NEGFLG /CHECK IF ONE DOTS CAN BE IGNORED SNA CLA / CAN IGNORE, IF W(N1,V) OR W(N1,C) JMP GTTXT6 /NEGATE OFF, MUST DRAW AC1 /NEGATE ON, CHECK WRITING MODE AND WRMODE / FOR OVERLAY OR COMPLEMENT (LSB SET) SNA CLA ACNEG1 /CAN IGNORE ONES GTTXT6, DCA SKIP1 /MARK FLAG / JMP I GTTXTR /EXIT / / SKIP0, 0 /DON'T DRAW ZERO DOTS FLAG (0=DRAW, -1=DON'T) SKIP1, 0 /DON'D DRAW ONE DOTS FLAG (0=DRAW, -1=DON'T) /------------------------------------------------------------------------------ / GTCBMP - LOAD USER DEFINED BIT MAP CHARACTER TO ALPHABET 1, 2 OR 3 /------------------------------------------------------------------------------ / GTCBMP, 0 GETPRM /GET THE SELECTED ALPHABET FOR LOADING SNA SPA /CHECK IF GREATER THEN ZERO JMP EXITLM /LESS THEN 0 OR 0 - EXIT INVALID ALPHABET DCA CSIZAB /SAVE THE SELECTED ALPHABET CLA CLL CMA RTL /-3 TAD CSIZAB /CHECK IF ALPHABET 1, 2 OR 3 SMA SZA CLA /SKIP IF VALID ALPHABET SELECTED FOR LOADING JMP EXITLM /INVALID ALPHABET SELECTED FOR LOADING - EXIT GETPRM /GET THE BIT MAP CHARACTER TO BE LOADED DCA DDCHAR /SAVE IT JMS CHKCHR /CHECK SELECTED CHAR FOR RANGE SZA CLA /SKIP IF CHAR WITHIN EXTENT OF ALPHABET JMP EXITLM /EXIT - CHAR SPECIFIED OUTSIDE OF EXTENT CLA CMA /GET ADDRESS -1 OF WHERE TO STORE UPDATED CHAR TAD CHRSTR /ADDRESS OF WHERE TO STORE UPDATED CHAR DCA AUTO12 /SAVE ADDRESS-1 TAD M12BMP /SETUP TO MOVE TEN PARTS OF BIT MAP CHAR DCA GTCBTM /SAVE COUNTER CBMPLP, JMS GETPAT /GET PART OF CHAR BIT MAP FROM CALLING FIELD DCA I AUTO12 /SAVE THE BIT MAP CHAR ROW IN CHAR STORAGE AREA ISZ GTCBTM /DONE ? JMP CBMPLP /NO - LOAD NEXT PART OF CHAR TAD CSIZAB /GET THE SELECTED ALPHABET JMS I BGTADR /GO GET ADDRESS OF BIT MAP CHAR IN PANEL RAM DCA CBMPAD /SAVE THE ADDRESS TO BIT MAP CHAR IN PANEL RAM PR3 /BLOCK MOVE FROM THIS FIELD TO PANEL RAM PBMFLD+4000+PRGFLD / FIELD REF FIX FOR WPS /C055A CHRSTR, ARRAY /ADDRESS OF WHERE UPDATED BIT MAP CHAR STORED CBMPAD, 0 /ADDRESS OF WHERE TO STORE CHAR IN PANEL RAM M12BMP, -12 /NUMBER OR WORDS TO MOVE 7777 /TERMINATOR EXITLM, CLA CLL /NEEDED FOR EXIT JMP I GTCBMP /EXIT CHKCHR, 0 / MINMAX /CHECK SELECTED CHAR TO BE WITHIN CHAR EXTENT DDCHAR /ADDRESS OF CHAR TO BE CHECKED CSIZFG /ADDRESS OF FLAG USED IN COMPARISONS K0040 /MINIMUM ALLOWED CHARACTER K0177 /MAXIMUM ALLOWED CHARACTER (+1) TAD CSIZFG /GET THE COMPARISON FLAG JMP I CHKCHR /EXIT WITH AC=VALIDITY OF CHAR EXTENT / BGTADR, GETADR GTCBTM, 0 K0040, 0040 /------------------------------------------------------------------------------ / GETPAT - GET LINE TEXTURE OR ROW OF CHAR BIT MAP AND CREATE MIRROR IMAGE OF IT /------------------------------------------------------------------------------ / GETPAT, 0 GETPRM /GET PART OF CHAR BIT MAP FROM CALLING FIELD AND K0377 /MASK TO EIGHT BITS DCA GTTXTR /SAVE THE BIT MAP CHARACTER ROW TAD M0010 /SETUP TO ROTATE LSB TO MSB FOR GDC DCA GETPTM /SAVE COUNTER FOR 8 BIT SHIFTING DCA GETPT1 /CLEAR NEW BIT MAP CHARACTER ROW CBMPL1, TAD GTTXTR /GET THE CHARACTER ROW TO BE SHIFTED CLL RAR /SHIFT LSB TO LINK DCA GTTXTR /SAVE THE SHIFTED CHARACTER ROW TAD GETPT1 /GET THE NEW CHARACTER ROW RAL /SHIFT LSB OF ORIGINAL TO MSB OF REAL ROW DCA GETPT1 /SAVE THE NEW CHARACTER ROW ISZ GETPTM /DONE ALL 8 BITS? JMP CBMPL1 /NO - SHIFT NEXT BIT UP TAD GETPT1 /GET THE MIRROW IMAGE OF ORIGINAL CHAR ROW JMP I GETPAT /EXIT WITH MIRROR IMAGE OF PATTERN IN AC / / GETPTM, 0 GETPT1, 0 PAGE /------------------------------------------------------------------------------ / GTATXT - GET AREA TEXTURE - SHADING CHARACTER /------------------------------------------------------------------------------ / GTATXT, 0 TAD SHDFLG /GET THE SHADE FLAG SZA CLA /SKIP IF NOT SET JMP SHDING /SHADING IS TURNED ON JMS I AUPDPT /GO UPDATE THE LINE PATTERN JMP I GTATXT /EXIT LINE PATTERN RESET SHDING, TAD ARETXT /GET THE AREA TEXTURE SZA /SKIP IF SHADING WITH LINE PATTERN JMP SWITHC /SHADING IS WITH CHARACTER TAD M0010 /BUILD A CHAR BIT MAP WITH LINE TEXTURE DCA ABITCT /SAVE THE 8 BIT COUNTER TAD SHDCHR /GET ADDRESS OF SHADE BIT MAP CHAR DCA SALPHA /SAVE THE ADDRESS TAD LINTXT /GET PRESENT LINE TEXTURE - DISREGARDING MULT DCA TEMP /SAVE IT LTXTLP, TAD TEMP /GET THE WORKING LINE PATTERN ROW CLL RAR /SHIFT RIGHT TO THE LINK DCA TEMP /SAVE UPDATED ROW PATTERN SZL /SKIP IF BIT 11 WAS A 0 TAD K0377 /LOAD BIT MAP WITH ALL ONES DCA I SALPHA /SAVE 1'S OR 0'S AS BIT MAP CHAR ROW ISZ SALPHA /UPDATE BIT MAP ROW POINTER ISZ ABITCT /UPDATE BIT COUNTER JMP LTXTLP /GO GET NEXT ROW OF BITS JMP I GTATXT /EXIT LINE PATTERN BIT MAP CHARACTER BUILT SWITHC, DCA DDCHAR /SAVE THE SHADE CHARACTER JMS I BCKCHR /CHECK CHAR FOR RANGE SNA CLA /SKIP IF INVALID CHARACTER JMP GTSCHR /GO GET THE BIT MAP FOR SHADE CHARACTER TAD K0177 /GREATER THEN EXTENT - DEFAULT TO 177 DCA DDCHAR /SAVE THE DEFAULT CHARACTER GTSCHR, TAD ACHRST /GET THE SELECTED ALPHABET JMS I AGTADR /GET PANEL RAM CHAR BIT MAP ADDRESS DCA SHDTXT /SAVE THE ADDRESS PR3 /GET CHAR BIT MAP FROM PANEL RAM 5000+PRGFLD+PBMFLD /BLOCK MOVE FROM PANEL RAM TO THIS FIELD SHDTXT, 0 /ADDRESS IN PANEL RAM OF BIT MAP CHAR SHDCHR, CHRBMP /ADDRESS IN THIS FIELD TO STORE BIT MAP -10 /NUMBER OF WORDS TO BE MOVED 7777 /TERMINATOR JMP I GTATXT /EXIT - CHAR BIT MAP SAVED / AUPDPT, UPDPAT SCOPY, COPDAT AGTADR, GETADR BCKCHR, CHKCHR ATXTPT, DRWPRM+1 ABITCT, 0 SALPHA, 0 K0200, 200 /----------------------------------------------------------------------------- / GTXTPV - TEXT PIXEL VECTOR MOVEMENT AROUND A CHARACTER /------------------------------------------------------------------------------ / GTXTPV, 0 / GETPRM /GET THE PIXEL VECTOR DIRECTION DCA GTXTTM /SAVE IT / TAD GTXTTM /GET DIRECTION CIF CDF TBLFLD /CALL ROUTINE IN TABFLD JMS I XTXTXP / TO DETERMINE DELTA X JMS I TUPDTX /CHANGE X POSITION / TAD GTXTTM /GET DIRECTION CIF CDF TBLFLD /CALL ROUTINE IN TABFLD JMS I XTXTYP / TO DETERMINE DELTA Y JMS I TUPDTY /CHANGE Y POSITION / JMP I GTXTPV /RETURN / / GTXTTM, 0 TUPDTX, UPDATX TUPDTY, UPDATY XTXTXP, TXTXPV XTXTYP, TXTYPV /------------------------------------------------------------------------------ / LDATXT - SETUP GDC'S AREA PARAMETERS WITH SHADE PATTERN /------------------------------------------------------------------------------ / LDATXT, 0 TAD XPOS1 /GET THE CURRENT X POSITION AND K0007 /MASK TO LOWER 3 BITS DCA MODX /SAVE IT TAD YPOS1 /GET THE CURRENT Y CO-ORDINATE CLL RAR /DIVIDE IT BY 2 IAC /ADD 1 AND K0007 /MASK TO LOWER 3 BITS DCA MODY /SAVE IT CLA CLL CMA /GET ADDRESS -1 OF SHADE PATTERN BUFFER TAD SHDCHR / TAD MODY /ADD MODULAR Y OFFSET TO ADDRESS DCA ATXTP0 /SAVE ADDRESS -1 OF STARTING BIT MAP PATTERN TAD M0010 /INITIALIZE TO MOVE 8 WORDS TAD MODY /UPDATE COUNTER BY MODULAR Y OFFSET JMS I SCOPY /COPY ALL OR PART OF BIT MAP PATTERN ATXTP0, 0 /ADDRESS-1 OF SOURCE (MODIFIED IN CODE) DRWPRM /ADDRESS-1 OF DESTINATION TAD AUTO11 /GET ADDRESS-1 OF NEXT AREA TO STORE DATA DCA ATXTP1 /SAVE ADDRESS-1 OF NEXT BUFFER STORAGE TAD M0010 /CALCULATE REMIANING BYTES TO MOVE TAD MODY /ADD MODULAR Y OFFSET TO IT CIA /NEGATE IT TAD M0010 /SUBTRACT THIS FROM NUMBER OF INITIAL WORDS SNA /SKIP IF MORE OF PATTERN TO BE MOVED JMP AFLIP /GO FLIP BITS BASED ON X OFFSET JMS I SCOPY /COPY START OF BIT MAP TO END OF AREA BIT MAP CHRBMP-1 /ADDRESS-1 OF SHADE PATTERN BUFFER ATXTP1, 0 /ADDRESS-1 OF DESTINATION (MODIFIED IN CODE) AFLIP, TAD M0010 /GET NUMBER OF BYTES TO BE SHUFFLED DCA TEMP /SAVE THE NUMBER OF BYTES TO SHUFFLE TAD ATXTPT /GET BASE ADDRESS OF BIT MAP CHARACTER DCA SALPHA /SAVE THE ADDRESS OF WORD TO BE SHIFTED SHUFLP, TAD MODX /GET THE OFFSET SNA /SKIP IF NOT 0 JMP I LDATXT /EXIT - SHIFTING OF BITS NOT NEEDED CIA /NEGATE OFFSET DCA ABITCT /SAVE AS BIT SHIFT COUNTER TAD I SALPHA /GET THE PATTERN TO BE UPDATED SHFTIT, CLL RAR /SHIFT RIGHT INTO LINK SZL /SKIP IF LINK = ZERO TAD K0200 /IF NOT 0 - REPLICATE BIT INTO LSB POSITION ISZ ABITCT /UPDATE THE BIT SHIFT COUNTER JMP SHFTIT /GO SHIFT AND REPLICATE AGAIN DCA I SALPHA /SAVE THE SHUFFLED PATTERN ISZ SALPHA /UPDATE POINTER TO WORDS TO BE SHUFFLED ISZ TEMP /UPDATE NUMBER OF BYTES TO SHUFFLE JMP SHUFLP /NOT DONE - SHUFFLE NEXT WORD JMP I LDATXT /EXIT FOR NOW - NO ROOM LEFT / ------------------------------------------------------ / PUTXYS - / ------------------------------------------------------ / PUTXYS, 0 / CLL RAL /MULTIPLY BY TWO TO THE SET OFFSET TAD PNTARY /ADD BASE ADDRESS OF ARRAY DCA TEMP /SAVE POINTER TO X AND Y SET / TAD I XPNTX /GET THE X COORDINATE DCA I TEMP /SAVE IT IN THE ARRAY / ISZ TEMP /UPDATE POINTER TO Y ELEMENT / TAD I XPNTY /GET THE Y COORDINATE DCA I TEMP /PUT IT IN THE ARRAY / JMP I PUTXYS /RETURN / / XPNTX, PNTX XPNTY, PNTY PNTARY, ARRAY PAGE /----------------------------------------------------------------------------- / DRWARC - DRAW AN ARC OR A CIRCLE <# OF DEGREES> / / INPUT: CENTER X AND Y CO-ORDINATES / NUMBER OF PLUS OR MINUS DEGREES IN ARC/CIRCLE (360) / ASSUMED: CURRENT CURSOR POSITION ON CIRCUMFERENCE /----------------------------------------------------------------------------- / DRWARC, 0 GETPRM /GET CENTER X FROM CALLING FIELD DCA XCENTR /SAVE IT GETPRM /GET CENTER Y FROM CALLING FIELD DCA YCENTR /SAVE IT GETPRM /GET + OR - # OF DEGREES IN ARC/CIRCLE SNA /SKIP IF NUMBER OF DEGREES > 0 JMP I DRWARC /EXIT - 0 DEGREES SPECIFIED DCA DEGRES /SAVE IT TAD XCENTR /CREATE THE X RADIUS CIA / SGNCHK /ADD TWO NUMBERS CHECKING FOR OVERFLOW XPOS1 / DCA XRAD /XRAD = XPOS1-XCENTR TAD YCENTR /CREATE THE Y RADIUS CIA / SGNCHK /ADD TWO NUMBERS CHECKING FOR OVERFLOW YPOS1 / DCA YRAD /YRAD = YPOS1-YCENTR JMS ARCPNT /GENERATE 4 POINTS 90 DEGREES APART JMS I GODRWA /GO DRAW THE ARC DCA INDEX /SET CURVE TO BE NOT IN PROGRESS DCA CLSCRV /SET CLOSE CURVE=FALSE JMP I DRWARC /EXIT / GODRWA, ARCDRW XCENTR, 0 YCENTR, 0 XRAD, 0 YRAD, 0 /------------------------------------------------------------------------------ / ARCPNT - PICK 4 POINTS 90 DEGREES APART TO BE USED IN ARC/CIRCLE DRAWING /------------------------------------------------------------------------------ / ARCPNT, 0 TAD DEGRES /USE THE SIGN OF DEGREES TO INDICATE DIRECTION SMA CLA /IF NEGITIVE STORE X AND Y IN SET 0 CLA CLL IAC RAL /ELSE STORE X+Y IN SET 2 OF ARRAY DCA INDEX /SAVE THE ARRAY INDEX TO THE SET TO UPDATE TAD YRAD /GET THE Y RADIUS JMS STPNTX /PNTX = XCENTR+YRAD TAD XRAD /GET THE Y RADIUS CIA /NEGATE IT JMS STPNTY /PNTY = YCENTR-XRAD JMS PUTPNT /STORE X AND Y IN ARRAY SET 0 OR 2 CLA CLL IAC /SETUP INDEX FOR SET 1 DCA INDEX /SAVE THE INDEX TAD XPOS1 /GET THE CURRENT X POSITION DCA PNTX /SAVE IT TAD YPOS1 /GET THE CURRENT Y POSITION DCA PNTY /SAVE IT JMS PUTPNT /STORE X AND Y IN ARRAY SET 1 TAD DEGRES /GET THE SIGN OF THE DEGREES SPA CLA /IF POSITIVE STORE X AND Y IN ARRAY SET 0 CLA CLL IAC RAL /ELSE STORE X AND Y IN ARRAY SET 2 DCA INDEX /SAVE INDEX INTO ARRAY SET 0 OR 2 TAD YRAD /GET THE Y RADIUS CIA /NEGATE IT JMS STPNTX /PNTX = XCENTR-YRAD TAD XRAD /GET THE X RADIUS JMS STPNTY /PNTY = YCENTR+XRAD JMS PUTPNT /STORE X AND Y IN ARRAY SET 0 OR 2 CLA CLL CML IAC RAL /INITIALIZE INDEX TO SET 3 DCA INDEX /SAVE THE INDEX TAD XRAD /GET THE X RADIUS CIA /NEGATE IT JMS STPNTX /PNTX = XCENTR-XRAD TAD YRAD /GET THE Y RADIUS CIA /NEGATE IT JMS STPNTY /PNTY = YCENTR-YRAD JMS PUTPNT /STORE THE POINTS IN ARRAY SET 3 ISZ INDEX /INDEX NOW EQUALS 4 JMP I ARCPNT /EXIT 4 POINTS 90 DEGREES APART SAVED IN ARRAY STPNTX, 0 SGNCHK /ADD/SUB XRAD/YRAD FROM XCENTR XCENTR DCA PNTX /SAVE THE RESULT OF ADD OR SUBTRACT JMP I STPNTX / STPNTY, 0 SGNCHK /ADD/SUB XRAD/YRAD FROM YCENTR YCENTR DCA PNTY /SAVE THE RESULT OF ADD OR SUBTRACT JMP I STPNTY / PUTPNT, 0 TAD INDEX /GET THE INDEX INTO ARRAY JMS I XPTXYS /GO STORE POINTS IN DRAW ARRAY CLA CLL CMA RTL /-3 TAD INDEX /GET THE INDEX INTO THE ARRAY SMA CLA /SKIP IF INDEX = 0 TO 2 JMP I PUTPNT /EXIT - INDEX = 3 CLA CLL IAC RTL /AC=4 TAD INDEX /ADD INDEX TO 4 - OFFSET TO POSITION ARRAY JMS I XPTXYS /GO STORE POINTS IN POSITION ARRAY JMP I PUTPNT /EXIT - DRAW AND POSITION ARRAYS UPDATED / / PNTX, 0 PNTY, 0 XPTXYS, PUTXYS / ----------------------------------------------------------- / TXTAPR - DRAW CHARACTER ROW FROM END OF UNIT TO END OF CELL / ----------------------------------------------------------- / TXTAPR, 0 /DRAW TEXT APRON / TAD I XXSKP0 /CHECK IF ZERO DATA TO BE WRITTEN SZA CLA JMP TXTAP8 /NO, GO RETURN / BLDPOS /BUILD A CURSOR POSITION STRING SPOSIT / AC1 /BUILD A FIGS DC PARAMETER TAD TXTAP6 /POINT TO FIGS STRING DCA AUTO10 / /CALCULATE NUMBER OF PIXELS NOT YET DONE TAD QDTWDC /GET NUMBER DOTS IN CELL TAD I PDTXM4 /SUBTRACT NUMBER DOTS IN CELL NOT YET DONE SNA JMP TXTAP4 /IF NO DOTS DONE, GO GET CELL WIDTH IN PIXELS / CIA DCA I PDTXM4 /SAVE NEGATIVE OF NUMBER OF DOTS DONE TXTAP1, TAD QTXTDC /ADD NUMBER PIXELS PER DOT DONE ISZ I PDTXM4 JMP TXTAP1 CIA TXTAP4, CDF TBLFLD /OTHER FIELD FOR # PHYSICAL PIXELS TAD I XGDCWD /SUBTRACT PIXELS DONE FROM CELL WIDTH CDF PRGFLD /BACK TO THIS FIELD SPA SNA /CHECK IF ANY PIXELS TO DO JMP TXTAP8 /NO, DON'T BOTHER DRAWING TAD M0001 /GDC USES #DOTS-1 JMS I XXXSVD /SAVE PARAMETER IN FIGS STRING / DRAWIT /DRAW SPOSIT TXTAP6, STEXT TXTPT0 / TXTAP8, CLA CLL JMP I TXTAPR /RETURN / / XXXSVD, SAVEDX XXSKP0, SKIP0 PDTXM4, DTXTM4 XGDCWD, ZGDCWD PAGE /------------------------------------------------------------------------------- / ARCDRW - CALCULATE QUADRANTS,# 10 DEGREE SEGMENTS,# DEG IN LAST SEG -DRAW ARC /------------------------------------------------------------------------------ / ARCDRW, 0 TAD DEGRES /GET NUMBER + OR - DEGREES IN THE ARC SPA /SKIP IF POSITIVE CIA /MAKE DEGREES ABSOLUTE DCA DEGRES /SAVE THE ABSOLUTE VALUE OF DEGREES TAD M550 /-360 DECIMAL TAD DEGRES /GET NUMBER OF DEGREES IN ARC SNA CLA /SKIP IF NOT CIRCLE CLA CLL CMA /CLOSE CURVE = TRUE (CIRCLE) DCA CLSCRV /CLOSE CURVE = FALSE IF NOT 360 DEGREES DCA QUADRT /CLEAR THE NUMBER OF QUADRANTS IN ARC CLA CLL CMA /GET NUMBER OF DEGREES -1 TAD DEGRES ARCDW1, TAD M132 /DIVIDE (DEGREES-1)/90 SPA /DONE DIVIDING ? JMP ARCDW2 /YES - GO ADD 1 TO QUADRANT ISZ QUADRT /UPDATE THE QUADRANT BY 1 JMP ARCDW1 /GO DO THE DIVIDE AGAIN ARCDW2, ISZ QUADRT /ADD 1 MORE TO QUADRANT IAC /UPDATE REMAINDER OF DIVISIION BY 1 TAD K132 /ADD 90 DEGREES BACK ONTO REMAIDER (DEG=1 TO 90) DCA DEGRES /SAVE NUMBER OF DEGREES IN THE LAST SEGMENT DCA LASSEG /CLEAR # OF SEGMENTS IN LAST ARC CLA CLL CMA /GET NUMBER OF REMAINING DEGREES -1 TAD DEGRES / ARCDW3, TAD M12ARC /DIVIDE (DEGREES-1)/10 SPA /DONE DIVIDING JMP ARCDW4 /YES - GO ADD 1 TO LAST SEGMENT COUNT ISZ LASSEG /UPDATE # OF SEGMENTS IN LAST QUADRANT BY 1 JMP ARCDW3 /GO DIVIDE AGAIN BY SUBTRACTING 10 ARCDW4, ISZ LASSEG /ADD 1 MORE TO # OF LAST SEGMENTS IAC /UPDATE REMAINDER OF DIVISION BY 1 TAD K12ARC /ADD 10 DEGREES BACK ON DCA DEGRES /SAVE THIS # OF REMAINING CORDS TAD QUADRT /GET THE NUMBER OF QUADRANTS CIA /NEGATE IT DCA QUADRT /USE NEGATED QUADRT AS COUNTER TAD BASARY /GET THE BASE ADDRESS OF THE ARRAY DCA DRWPNT /SAVE IT ARCDW5, ISZ QUADRT /CHECK IF DOING THE LAST QUADRANT JMP ARCDW7 /NO - GO DRAW THIS QUADRANT TAD LASSEG /GET THE # OF SEGMENTS IN LAST QUADRANT DCA SEG /SAVE IT TAD DEGRES /GET # OF CORDS IN LAST SEG DCA REMAIN /SAVE IT TAD DRWPNT /GET POINTER TO 4 SETS OF X AND Y POINTS DCA ARCDW6 /SAVE IT JMS I DOCURV /GO DRAW THE LAST ARC ARCDW6, 0 /BASE ADDRESS OF THE 4 POINTS IN ARRAY JMP I ARCDRW /EXIT - CURVE HAS BEEN COMPLETED ARCDW7, TAD DRWPNT /GET THE BASE ARRAY ADDRESS OF THE 4 POINTS JMS I FLARC /GO DRAW A FULL ARC ISZ DRWPNT /UPDATE THE BASE ADDRESS BY 2 ISZ DRWPNT / JMP ARCDW5 /GO DO NEXT QUADRANT / DOCURV, XCURVE FLARC, FULARC BASARY, ARRAY DRWPNT, 0 QUADRT, 0 LASSEG, 0 M550, -550 M132, -132 K132, 132 M12ARC, -12 K12ARC, 12 /------------------------------------------------------------------------------ / XCURVE - ROUTINE TO DO CURVE INTERPOLATION AND DRAW THE CURVE /------------------------------------------------------------------------------- / XCURVE, 0 TAD I XCURVE /GET THE BASE ADDRESS OF THE 4 POINTS DCA I XPTADR /SAVE BASE ADDRESS OF 4 SETS OF CO-ORDINATES ISZ XCURVE /UPDATE POINTER FOR RETURN DCA I XCI /CLEAR COLUMN INDEX INTO ITERPOLATION ARRAY CRVLP1, TAD I XPTADR /SETUP FOR X INTERPOLATION ON 4 POINTS JMS I ACSUM /GO DO INTERPOLATION FOR X XPOS1 /ADDRESS OF CURRENT X DCA XPOS2 /SAVE THE "TO" X POSITION CLA CLL IAC /SETUP FOR Y INTERPOLATION ON 4 POINTS TAD I XPTADR /POINT TO BASE Y CO-ORDINATE JMS I ACSUM /GO DO INTERPOLATION FOR Y YPOS1 /ADDRESS OF CURRENT Y DCA YPOS2 /SAVE THE "TO" Y POSITION DRWVEC /GO DRAW NTH OF 8 SEGMENTS ISZ I XCI /UPDATE THE COLUMN INDEX TAD I XCI /GET THE UPDATED INDEX CIA /NEGATE IT TAD SEG /GET THE NUMBER OF SEGMENTS SZA CLA /SKIP IF DONE JMP CRVLP1 /GO INTERPOLATE FOR NEXT SEGMENT JMP I XCURVE /EXIT / XPTADR, PNTADR ACSUM, ACUSUM XCI, CI /----------------------------------------------------------------------------- / INTRPT - CURVE FITTING INTERPOLATION TABLE /------------------------------------------------------------------------------ / DECIMAL INTRPT, -9 125 13 -1 -14 117 29 -4 -16 104 48 -8 -15 87 68 -12 -12 68 87 -15 -8 48 104 -16 -4 29 117 -14 -1 13 125 -9 0 0 128 0 OCTAL PAGE /------------------------------------------------------------------------------- / CRVBGN - CURVE BEGIN OPEN /------------------------------------------------------------------------------ / CRVBGN, 0 DCA CLSCRV /CLOSE CURVE=FALSE (CRVBGN) - TRUE (CRVCLS) DCA INDEX /INITIALIZE INDEX TO FIRST ELEMENT JMS SVPOSA /SAVE X AND Y IN POSITION ARRAY JMS SVDRWA /SAVE X AND Y IN DRAW ARRAY ISZ INDEX /UPDATE ARRAY INDEX BY 1 JMP I CRVBGN /EXIT - CURVE BEGIN OPEN /------------------------------------------------------------------------------- / CRVCLS - CURVE BEGIN CLOSED /------------------------------------------------------------------------------ / CRVCLS, 0 CLA CLL CMA /SET CLOSE CURVE FLAG = TRUE JMS CRVBGN /GO DO SAME OPERATION AS CURE BEGIN OPEN JMP I CRVCLS /EXIT CURVE BEGIN CLOSED / SVPOSA, 0 /SAVE X AND Y CO-ORDINATES IN POSITION ARRAY CLA CLL IAC RTL /AC=4 OFFSET INDEX INTO POSITION ARRAY TAD INDEX /GET THE ARRAY INDEX JMS STORXY /GET CO-ORDINATES AND STORE IN POSITION ARRAY JMP I SVPOSA /EXIT / SVDRWA, 0 /SAVE X AND Y CO-ORDINATES IN DRAW ARRAY TAD INDEX /GET THE ARRAY INDEX JMS STORXY /GET CO-ORDINATES AND STORE IN POSITION ARRAY JMP I SVDRWA /EXIT / STORXY, 0 /STORE X AND Y CO-ORDINATES IN ARRAY CLL RAL /MULTIPLY INDEX BY 2 TO GET TO CORRECT SET TAD ADRARY /ADD BASE ADDRESS OF ARRAY TO INDEX DCA ELMPOS /SAVE AS ADDRESS OF FIRST ELEMENT (X) GETPRM /GET THE X CO-ORDINATE FROM CALLING FIELD DCA I ELMPOS /SAVE IT ISZ ELMPOS /UPDATE POINTER TO Y ELEMENT GETPRM /GET THE Y CO-ORDINATE FROM CALLING FIELD DCA I ELMPOS /SAVE IT CLA CLL CMA RAL /-2 RESET POINTER TO CALLING FIELDS PARAMETERS TAD PTABLE /ADDRESS OF CALLING FIELDS CONTROL BLOCK DCA PTABLE /RESTORE ORIGINAL POINTER TO PARAMETERS JMP I STORXY /EXIT X AND Y CO-ORDINATES SAVED /------------------------------------------------------------------------------- / CRVCNT - CURVE CONTINUE /------------------------------------------------------------------------------- / CRVCNT, 0 TAD INDEX /GET CURVE IN PROGRESS FLAG SZA CLA /SKIP IF NOT PREVIOUS CLOSE/OPEN CURVE JMP CRVCT1 /CURVE IN PROGRESS - CONTINUE GETXY2 /GET THE "TO" CO-ORDINATES DRWVEC /DRAW THE VECTOR TO IT FROM WHEREVER WE ARE JMP I CRVCNT /EXIT - VECTOR DRAWN CRVCT1, CLA CLL CMA RTL /-3 TAD INDEX /GET THE INDEX INTO THE ARRAY SMA SZA CLA /SKIP IF INDEX = 1, 2 OR 3 JMS MOVDWN /INDEX>=4 - MOVE ELEMENTS IN DRAW ARRAY DOWN CLA CLL CMA RTL /-3 TAD INDEX /GET THE PRESENT ARRAY INDEX SPA CLA /SKIP IF 3 OR GREATER JMS SVPOSA /SAVE NEW X AND Y CO-ORDINATES IN POSITION ARRAY JMS SVDRWA /SAVE NEW X AND Y CO-ORDINATES IN DRAW ARRAY CLA CLL CMA /-1 TAD INDEX /GET THE ARRAY INDEX SNA CLA /SKIP IF INDEX WAS NOT EQUAL TO 1 GETXY1 /USE THESE CO-ORDINATES AS FIRST POINT OF CURVE ISZ INDEX /UPDATE THE INDEX INTO ARRAY BY 1 (4 IS MAX) TAD INDEX /GET THE UPDATED ARRAY INDEX TAD M0004 /SUBTRACT 4 FROM IT SPA CLA /SKIP IF UPDATED INDEX = 4 OR GREATER JMP I CRVCNT /EXIT - UPDATED INDEX < 4 TAD ADRARY /BASE ADDRESS OF 4 POINTS TO INTERPOLATE ON JMS I XFULAR /GO SETUP FOR A FULL ARC JMP I CRVCNT /EXIT CURVE CONTINUE / ADRARY, ARRAY ELMPOS, 0 XFULAR, FULARC /------------------------------------------------------------------------------ / CRVEND - CURVE END - COMPLETES CURVE IN PROGRESS /------------------------------------------------------------------------------ / CRVEND, 0 TAD ADRARY /GET THE BASE ADDRESS OF WORKING 4 POINTS DCA ELMPOS /SAVE IT TAD INDEX /GET THE CURVE IN PROGRESS FLAG SNA CLA /SKIP IF A CURVE WAS IN PROGRESS JMP EXTEND /EXIT - BAD CALL NO CURVE BEGIN CALL MADE TAD CLSCRV /GET CLOSE CURVE FLAG SMA CLA /SKIP IF CLOSE CURVE = TRUE JMP CRVUPP /OPEN CURVE - UPDATE POSITION TO LAST GIVEN TAD INDEX /GET THE ARRAY INDEX TAD M0004 /CHECK IF 4 POINTS MINIMUM RECEIVED SZA CLA /SKIP IF YES - GO FINISH CURVE JMP CRVEN6 /NO - UPDATE POSITION TO FIRST GIVEN CLA CLL CMA RTL /-3 DCA MOVDWN /SAVE COUNTER TO INCLUDE 1ST 3 POSITIONS GIVEN CRVEOC, ISZ ELMPOS /UPDATE ARRAY POINTER TO INCLUDE 1ST GIVEN PT. ISZ ELMPOS / TAD ELMPOS /GET BASE ADDRESS OF 4 POINTS TO INTERPOLATE ONE JMS I XFULAR /GO DRAW THE FULL ARC ISZ MOVDWN /INCLUDED 1ST 3 POSITIONS? JMP CRVEOC /NO - INCLUDE 2ND OR THIRD POSITION GIVEN AC7776 /GET A MINUS TWO (BECOMES -3) FOR START POINT / CRVUPP, TAD M0001 /SUBTRACT 1 FROM THE PRESENT ARRAY INDEX TAD INDEX / CRVEN6, CLL RAL /MULTIPLY BY 2 TO GET CORRECT X + Y SET TAD ELMPOS /ADD BASE ADDRESS OF 4 POINTS DCA ELMPOS /SAVE POINTER TO X AND Y ELEMENTS TAD I ELMPOS /GET THE X ELEMENT DCA XPOS1 /SAVE AS PRESENT X ISZ ELMPOS /UPDATE POINTER TO Y ELEMENT TAD I ELMPOS /GET THE Y ELEMENT DCA YPOS1 /SAVE AS PRESENT Y EXTEND, DCA INDEX /CLEAR CURVE IN PROGRESS AND ARRAY INDEX DCA CLSCRV /SET CLOSE CURVE TO FALSE JMP I CRVEND /EXIT - CURVE END /------------------------------------------------------------------------------ / MOVDWN - MOVE TOP 3 SETS OF CO-ORDINATES DOWN IN DRAW ARRAY + ADD NEW SET /------------------------------------------------------------------------------ / MOVDWN, 0 TAD ADRARY /GET BASE ADDRESS OF ARRAY TAD M0001 /RESULT = ADDRESS OF DRAW ARRAY -1 DCA AUTO11 /SAVE ADDRESS OF DRAW ARRAY -1 CLA CLL IAC RAL /AC = 2 TAD AUTO11 /RESULT = ADDRESS OF DRAW ARRAY 2ND ELEMENT-1 DCA AUTO10 /SAVE THE ADDRESS CLA CLL CMA RTL /AC = -3 DCA INDEX /SETUP TO MOVE 3 SET OF CO-ORDINATES DOWN CLA CLL /NEEDED TO CLEAR THE LINK MOVDN1, TAD I AUTO10 /GET ELEMENT TO BE MOVED DCA I AUTO11 /OVERLAY EXISTING ELEMENT CML /USED AS SET COUNTER SZL /SKIP IF X AND Y CO-ORDINATES MOVED JMP MOVDN1 /SET NOT MOVED - NOW MOVE Y CO-ORDINATE ISZ INDEX /DONE MOVING ALL 3 SETS JMP MOVDN1 /NO - MOVE NEXT SET OF CO-ORDINATES DOWN CLA CLL CML IAC RAL /AC=3 DCA INDEX /SET INDEX INTO ARRAY = 3 FOR 4TH POSITION JMP I MOVDWN /EXIT - 3 SETS OF CO-ORDINATES MOVED DOWN PAGE /------------------------------------------------------------------------------- / ACUSUM - CURVE INTERPOLATION ROUTINE /------------------------------------------------------------------------------ / ACUSUM, 0 /GET X OR Y CO-ORDINATE BY INTERPOLATION DCA BASADR /SAVE BASE ADDRESS OF X OR Y ELEMENT TAD I ACUSUM /GET ADDRESS OF CURRENT X OR Y POSITION DCA CRNTXY /SAVE IT ISZ ACUSUM /UPDATE POINTER FOR RETURN DCA SUM3 /CLEAR THE ACCUMULATIVE 4 WORD SUM DCA SUM2 / DCA SUM1 / DCA SUM0 / DCA J /CLEAR THE WORKING INDEX ACSMLP, TAD J /GET THE WORKING INDEX CLL RAL /MULTIPLY BY 2 TO GET ELEMENT INDEX TAD BASADR /ADD BASE ADDRESS OF 4 POINT ARRAY DCA PNTELM /SAVE POINTER TO X OR Y ELEMENT TAD I PNTELM /GET THE X OR Y ELEMENT DCA PNTELM /SAVE THE X OR Y ELEMENT CNVDBL /CONVERT X OR Y ELEMENT TO DOUBLE PRECISSION PNTELM /ADDRESS OF WORD TO BE SIGNED EXTEND PTELMH /HIGH WORD ADDRESS OF WHERE TO STORE RESULT TAD CI /GET COLUMN INDEX INTO INTERPOLATION ARRAY CLL RTL /MULTIPLY BY 4 TAD J /ADD THE ELEMENT INDEX TO IT TAD BASITR /ADD BASE ADDRESS OF INTERPOLATION ARRAY DCA ITRELM /SAVE POINTER TO INTERPOLATION ELEMENT TAD I ITRELM /GET THE X OR Y ELEMENT DCA ITRELM CNVDBL /CONVERT INTERPOLATION ELEMENT TO SIGN EXTEND ITRELM /ADDRESS OF WORD TO BE CONVERTED ITELMH /HIGH WORD ADDRESS OF WHERE TO STORE RESULTS DBLMTY /MULITPY CO-ORDINATE BY INTERPOLATION VALUE PTELMH /ADDRESS OF TWO WORD MULTIPLICAND ITELMH /ADDRESS OF TWO WORD MULTIPLIER CLA CLL /ADD RESULT OF MULTIPLICATION TO TOTAL SUM TAD SUM0 /ADD LEAST SIGNIFICANT WORDS TAD MQLW DCA SUM0 /SAVE RESULT GLK /GET THE CARRY TAD MQHW /ADD NEXT SIGNIFICANT WORDS TAD SUM1 / DCA SUM1 /SAVE THE RESULT GLK /GET THE CARRY TAD ACLW /ADD NEXT SIGNIFICANT WORDS TAD SUM2 / DCA SUM2 /SAVE THE RESULT GLK /GET THE CARRY TAD ACHW /ADD THE MOST SIGNIFICANT BITS TAD SUM3 / DCA SUM3 /SAVE THE FINL RESULT ISZ J /UPDATE THE WORKING INDEX TAD J /GET TEH UPDATED INDEX TAD M0004 /CHECK IF DONE ALL 4 POINTS SZA CLA /SKIP IF DONE JMP ACSMLP /NOT DONE - DO NEXT POINT OF INTERPOLATION TAD SUM3 /MOVE ACCUMULATIVE SUM TO 4 WORD ACCUMULATOR DCA ACHW / TAD SUM2 / DCA ACLW / TAD SUM1 / DCA MQHW / TAD SUM0 / DCA MQLW / DBLDIV /DIVIDE ACCUMULATVE SUM BY 128 CRVDVH /ADDRESS OF 2 WORD DIVISOR CLA CMA /GET LAST SEGMENT -1 TAD SEG / CIA /NEGATE IT TAD CI /GET THE CURRENT COLUMN INDEX SZA CLA /DOING THE LAST SEGMENT OF THE ARC JMP NOTLAS /NO - GO CHECK X OR Y FOR OVERFLOW TAD MQHW /SETUP FOR SUBTRACT BY COPYING QUOTIENT ABOVE DCA ACHW / TAD MQLW / DCA ACLW / CNVDBL /CONVERT CURRENT X OR Y TO SIGN EXTENSION CRNTXY, 0 /ADDRESS OF WORD TO BE CONVERTED PTELMH /ADDRESS OF WHERE TO STORE CURRENT X OR Y DBLSUB /SUBTRACT CURRENT POSITION FROM INTERPOLATED PTELMH /ADDRESS OF DOUBLE WORD TO BE SUBTRACTER ITELMH /ADDRESS OF WHERE TO STORE RESULT CNVDBL /CONVERT REMANING CORDS TO DOUBLE PRECISION REMAIN /ADDRESS OF WORD TO BE CONVERTED SUM3 /ADDRESS OF WHERE TO STORE THE RESULT DBLMTY /MULT DELTA X OR Y BY NUMBER OF REMAINING CORDS ITELMH /ADDRESS OF TWO WORD DELTA X OR Y SUM3 /ADDRESS OF TWO WORD MULTIPIER DBLDIV /DIVIDE (DELTA X OR Y * REMAIN)/10 CRD10H /ADDRESS OF TWO WORD DIVISOR TAD MQHW /SETUP FOR ADDITION - COPY QUOTIENT DCA ACHW TAD MQLW DCA ACLW DBLADD /ADD CURRENT X OR Y TO THE RESULT OF ABOVE PTELMH /ADDRESS OF TWO WORD CURRENT POSITION MQHW /ADDRESS OF WHERE TO STORE 2 WORD RESULT NOTLAS, TAD MQHW /GET HIGH WORD OF QUOTIENT SMA /SKIP IF NEGATIVE JMP ACSM1 /POSITIVE - CHECK FOR POSITVE OVERFLOW CMA /TRY TO MAKE AC A ZERO SNA CLA /SKIP IF OVERFLOW ERROR TAD MQLW /GET THE LOW WORD SMA /SKIP IF LOW WORD NEGATIVE CLA CLL CML RAR /DEFAULT NUMBER TO -2047 JMP I ACUSUM /EXIT WITH X OR Y VALUE IN AC ACSM1, SZA CLA /SKIP IF HIGH WORD EUALS ZERO JMP ACSM2 /WORD TO LARGE - DEFAULT TO MAX TAD MQLW /GET THE LOW WORD SPA /SKIP IF LOW WORD VALID ACSM2, AC3777 /DEFALUT NUMBER TO +2027 JMP I ACUSUM /EXIT / PNTADR, 0 BASITR, INTRPT CI, 0 J, 0 BASADR, 0 PNTELM, 0 ITRELM, 0 PTELMH, 0; 0 ITELMH, 0; 0 CRVDVH, 0000; 0200 CRD10H, 0000; 0012 SUM3, 0 SUM2, 0 SUM1, 0 SUM0, 0 PAGE /------------------------------------------------------------------------------ / RSTCUR - RESTORE CURSOR TO CORRECT POSITION AT END OF TEXT STRING /------------------------------------------------------------------------------ / / DOES NOTHING FOR NOW, CHANGED VERSION 23, KAH / RSTCUR, 0 CLA CLL JMP I RSTCUR / / / / /------------------------------------------------------------------------------ / GTNEGM - DISABLE/ENABLE NEGATE MODE /------------------------------------------------------------------------------ / GTNEGM, 0 GETPRM /GET NEGATE SELECTION FROM CALLING FIELD DCA NEGFLG /NOT NEGATED=0 - NEGATED<>0 JMP I GTNEGM /EXIT / / /------------------------------------------------------------------------------ / XAREA - DRAW A FILLED RECTANGLE /------------------------------------------------------------------------------ / XAREA, 0 CLA CLL TAD XPOS2 /GET THE NEW "TO" X CO-ORDINATE AND SAVE DCA ARXPOS /SAVE IT TAD YPOS2 /GET THE NEW "TO" Y CO-ORDINATE AND SAVE DCA ARYPOS /SAVE IT JMS I ARECLP /GO CHECK IF CLIPPING NEEDED ON AREA FILL JMP NOAREA /AREA OUTSIDE OF CLIPPING REGION TAD YPOS1 /GET THE 1ST LOGICAL Y CO-ORDINATE CLL RAR /DIVIDE BY 2 DCA PYPOS1 /SAVE IT TAD YPOS2 /GET THE 2ND LOGICAL Y CO-ORDINATE CLL RAR /DIVIDE BY 2 DCA PYPOS2 /SAVE IT BLDPOS /CREATE POSITION CURSOR STRING SPOSIT TAD PSAREA /GET ADDRESS OF STRING DCA AUTO10 / / CREATE THE FIGS STRING / TAD PYPOS2 /SVAE YPOS1 - YPOS2 AS P2 AND P3 (DC) CIA TAD PYPOS1 JMS I XSAVED TAD XPOS1 /TEMP=XPOS2 - XPOS1 +1 CIA TAD XPOS2 IAC DCA ARTEMP TAD ARTEMP /SAVE TEMP AS P4 AND P5 (D) JMS I XSAVED TAD ARTEMP /SAVE TEMP AS P6 AND P7 (D2) JMS I XSAVED / DRAW THE FILLED AREA / DRAWIT /DRAW AN AREA SPOSIT / AT THIS POSITION SAREA / AS A FILLED AREA AREPAT NOAREA, CLA CLL TAD ARXPOS /RESET ENDING CO-ORDINATES AS "TO" CO-ORDINATES DCA XPOS1 TAD ARYPOS DCA YPOS1 JMP I XAREA /RETURN / ARXPOS, 0 ARYPOS, 0 ARECLP, ARCLIP ARTEMP, 0 PSAREA, SAREP1 XSAVED, SAVEDX / ----------------------------------------------------------------------------- / GETADR - CREATE ADDRESS OF CHARACTER BIT MAP FROM CHARACTER CODE AND ALPHABET / ----------------------------------------------------------------------------- / GETADR, 0 /GET ADDRESS OF CHAR BIT MAP IN PANEL RAM TAD PALPHT /ADD POINTER TO CHARACTER SET SELECTED DCA GETATM /SAVE THE POINTER TO THE CHAR SET BASE ADDRESS TAD DDCHAR /GET THE GRAPHIC CHAR TO BE DISPLAYED TAD M0040 /ADJUST FOR OFFSET INTO CHAR SET BIT MAP DCA GETAT1 /MULTIPLY BY TEN DECIMAL TAD GETAT1 CLL RTL TAD GETAT1 CLL RAL TAD I GETATM /ADD BASE ADDRESS OF CHAR SET TO CHAR OFFSET JMP I GETADR /EXIT - WITH ADDDRESS OF CHAR BIT MAP IN AC / PALPHT, ALPHTA ALPHTA, 000; 1700; 3600; 5500 GETATM, 0 M0040, -40 GETAT1, 0 / / / ----------------------------- / ARRAY - GENERAL PURPOSE ARRAY / ----------------------------- / ARRAY, ZBLOCK 16 / / / /----------------------------------------------------------------------------- / WMDSLN - DETERMINE IF SHADE TO Y REFERENCE OR Y REFERENCE -2 /------------------------------------------------------------------------------- / WMDSLN, 0 CLA CLL CMA RAL /-2 TAD WRMODE /GET THE CURRENT WRITING MODE SZA CLA /SKIP IF WRITING MODE = COMPLEMENT JMP I WMDSLN /NOT COMPLEMENT - SHADE TO REFERENCE LINE CLA CLL IAC /SETUP TO CHECK IF Y REFERENCE AFTER SCREEN TAD YREFLG /GET THE Y REFERENCE FLAG SZA CLA /SKIP IF AFTER - SHADE TO Y REFERNECE LINE CLA CLL CMA RAL /BEFORE OR ON - SHADE TO Y REFERENCE -2 JMP I WMDSLN /EXIT TO GET THE Y REFERENCE LINE / --------------------------- / TEXT GDC PARAMETERS STRINGS / --------------------------- / / FOR ZERO BITS / TXTPT0, 570; 0; 0; 0; 0; 0; 0; 0; 0 7777 / / FOR ONE BITS / TXTPT1, 570; 377; 377; 377; 377; 377; 377; 377; 377 7777 / / ---------------- / TEXT FIGS STRING / ---------------- / STEXT, 514; 020; 0; 0; 1; 0; 1; 0 /FIGS (MODIFIED IN CODE) 550 /GCHRD 7777 /TERMINATOR PAGE /-------------------------------------------------------------------------------- / LINCHK - ROUTINE TO DETERMINE THE LINES IDENTITY /------------------------------------------------------------------------------ / ON EXIT LOCATION "SLPOFS" = ONE OF THE FOLLOWING: / / SLOPE=0 SLOPING DOWNWARD TO LEFT -SLOPE / SLOPE=1 SLOPING DOWNWARD TO RIGHT +SLOPE / SLOPE=2 SLOPING UPWARD TO LEFT +SLOPE / SLOPE=3 SLOPING UPWARD TO RIGHT -SLOPE / SLOPE=4 VERTICAL LINE / SLOPE=5 HORIZONTAL LINE / SLOPE=6 DOT / LINCHK, 0 JMS CHKY12 /GO CHECK IF Y1 = Y2 AND RETURN WITH SLOPE CLA CLL /NEEDED HERE CNVDBL /CONVERT SINGLE WORD TO DOUBLE XPOS1 /ADDRESS OF WORD TO BE CONVERTED TDBLWH /ADDRESS OF WHERE TO STORE CONVERTED WORD CNVDBL /CONVERT SINGLE WORD TO DOUBLE XPOS2 /ADDRESS OF WORD TO BE CONVERTED ACHW /WHERE TO STORE WORDS - SETUP FOR SUBTRACTION DBLSUB /GO GENERATE DELTAX (XPOS2 - XPOS1) TDBLWH /ADDRESS OF WORD TO BE SUBTRACTED SLPDXH /ADDRESS OF WHERE RESULT IS TO BE STORED / CNVDBL /CONVERT SINGLE WORD TO DOUBLE YPOS1 /ADDRESS OF WORD TO BE CONVERTED TDBLWH /ADDRESS OF WHERE TO STORE CONVERTED WORD CNVDBL /CONVERT SINGLE WORD TO DOUBLE YPOS2 /ADDRESS OF WORD TO BE CONVERTED ACHW /WHERE TO STORE WORDS - SETUP FOR SUBTRACTION DBLSUB /GO GENERATE DELTAY (YPOS2 - YPOS1) TDBLWH /ADDRESS OF WORD TO BE SUBTRACTED SLPDYH /ADDRESS OF WHERE RESULT IS TO BE STORED / DCA SLPOFS /INITIALIZE THE SLOPE OFFSET TAD SLPDXH /CHECK IF VERTICAL LINE SZA CLA JMP LNCHK1 /IF NOT 0 THEN CHECK FOR HORIZONTAL LINE TAD SLPDXL / SNA CLA /SKIP IF NOT VERTICAL LINE ISZ SLPOFS /INDICATE A VERTICAL LINE LNCHK1, TAD SLPDYH /CHECK IF A HORIZONTAL LINE SZA CLA JMP LNCHK2 /IF <> 0 CHECK IF LINE PREVIOUS LINE HORIZONTAL TAD SLPDYL / SZA CLA /SKIP IF A HORIZONTAL LINE JMP LNCHK2 /NO HORIZONTAL LINE - CONTINUE ISZ SLPOFS /0 TO 1 OR 1 TO 2 ISZ SLPOFS /1 TO 2 OR 2 TO 3 LNCHK2, TAD SLPOFS /GET THE SLOPE INDICATOR SZA CLA /SKIP IF NOT A HORIZONTAL,VERTICAL OR DOT LINE AC0003 /ADD 3 TO NUMBER TAD SLPOFS /GET THE SLOPE INDICATOR SZA /SKIP IF NONE OF THE ABOVE JMP LNCHK3 /GO SAVE SLOPE INDICATOR FOR ABOVE TYPE LINES / TAD SLPDXH /CHECK IF SLOPING TO LEFT OR RIGHT SMA CLA /SKIP IF LEFT X1 > X2 AC1 /TO THE RIGHT X1 < X2 DCA SLPOFS /SAVE THE SLOPE FLAG TAD SLPDYH /CHECK IF SLOPING DOWN OR UP SPA CLA /SKIP IF DOWN Y1 < Y2 AC0002 /UP Y1 > Y2 TAD SLPOFS /GET THE PREVIOUS SLOPE FROM X LNCHK3, DCA SLPOFS /SAVE THE SLOPE FLAG DCA XDIF /CLEAR X AND Y TRAVERSING DIRECTIONS DCA YDIF / TAD SLPOFS /GET THE LINE INDICATOR TAD M0006 /CHECK IF A DOT SNA CLA /SKIP IF NOT A DOT JMP LNCHKE /NO - THE LINE IS A DOT - EXIT TAD SLPDXH /GET THE HIGH WORD OF X CALCULATED SLOPE SPA CLA /SKIP IF POSITIVE X1 < X2 CLA CLL CMA RAL /SET X TRAVERSING DIRECTION = -1 IAC /SET X TRAVERSING DIRECTION = +1 DCA XDIF /SAVE THE X TRAVERSING DIRECTION TAD SLPDYH /GET THE HIGH WORD OF Y CALCULATED SLOPE SPA CLA /SKIP IF POSITVE Y1 < Y2 CLA CLL CMA RAL /SEY Y TRAVERSING DIRECTION = -1 IAC /SET Y TRAVERSING DIRECTION = +1 DCA YDIF /SAVE THE Y TRAVERSING DIRECTION TAD SLPOFS /GET THE LINE INDICATOR TAD M0004 /CHECK IF LINE HORIZONTAL OR VERTICAL SPA /SKIP IF HORIZONTAL OR VERTICAL LINE JMP LNCHKE /EXIT NOT HORIZONTAL OR VERTICAL SNA /SKIP IF HORIZONTAL LINE DCA XDIF /VERTICAL LINE - CLEAR X TRAVERSING DIRECTION SZA CLA /SKIP IF VERTICAL LINE DCA YDIF /HORIZONTAL LINE - CLEAR Y TRAVERSING DIRECTION LNCHKE, CLA CLL /NEEDED TO CLEAN UP THE AC JMP I LINCHK /EXIT BACK TO CALLER / TDBLWH, 0; 0 M0006, -0006 /----------------------------------------------------------------------------- / CHKY12 - CHECK IF Y1/2 = Y2/2 - IF YES SET Y1=Y2 - RETURN WITH SLOPE IN AC /------------------------------------------------------------------------------ CHKY12, 0 TAD YPOS1 /GET Y POSITION 1 CLL RAR /DIVIDE IT BY 2 DCA HALFY1 /SAVE Y1/2 TAD YPOS2 /GET Y POSITION 2\ CLL RAR /DIVIDE BY 2 TO GET EQIVALENT RASTER LINE DCA HALFY2 /SAVE Y2/2 TAD HALFY1 /COMPARE Y1/2 AGAINST Y2/2 CIA TAD HALFY2 /GET IT SZA /ARE THE TWO POINTS EQUAL JMP I CHKY12 /NO - EXIT TAD YPOS2 /YES THEN MAKE 1ST Y POSITION = "TO" Y DCA YPOS1 /SAME RASTER LINE JMP I CHKY12 /EXIT Y1=Y2 NOW / HALFY1, 0 HALFY2, 0 /------------------------------------------------------------------------------ / OVRLAY - OVERLAY EQ1 AND EQ2 POINTERS /------------------------------------------------------------------------------ / OVRLAY, 0 DCA AUTO10 /SAVE THE POINTER TO OVERLAY TABLE TAD M0005 /SETUP TO OVERLAY 5 ADDRESS IN EQUATION DCA OVRCNT /SAVE THE OVERLY COUNTER OVRLY1, TAD I AUTO10 /GET THE ADRESS TO BE OVERLAYED FROM TABLE DCA OVRTMP /SAVE THE ADDRESS TAD OVRADR /GET THE ADDRESS TO OVERLAY DCA I OVRTMP /OVERLAY EQUATION'S ADDRESS ISZ OVRCNT /DONE ? JMP OVRLY1 /NO - OVERLAY NEXT ADDRESS JMP I OVRLAY /RETURN / OVRADR, 0 OVRCNT, 0 OVRTMP, 0 M0005, -0005 /----------------------------------------------------------------------------- / DHVLIN - DOT - HORIZONTAL - VERTICAL LINE CHECK -(IGNORE VERT IF COMP MODE) /------------------------------------------------------------------------------ / DHVLIN, 0 TAD M0004 /-4 TAD SLPOFS /GET THE LINE INDICATOR SPA /SKIP IF DOT, HORIZONTAL OR VERTICAL LINE JMP SLPEXT /EXIT CALL +1 FOR A SLOPED LINE SZA CLA /SKIP IF VERTICAL LINE JMP DHVEXT /EXIT CALL+3 FOR A DOT AND HORIZONTAL LINE CLA CLL CMA RAL /-2 TAD WRMODE /GET THE WRITING MODE SNA CLA /EXIT CALL+3 IF NOT COMPLEMENT MODE JMS I XTRVLN /COMP MODE - RET CALL+1 OR CALL+2(TRUE VERT) DHVEXT, ISZ DHVLIN /EXIT - DOT,HORIZONTAL,VERTICAL(NOT COMP) ISZ DHVLIN /EXIT - VERTICAL LINE COMPLEMENT MODE SLPEXT, CLA CLL /EXIT - SLOPED LINE JMP I DHVLIN /EXIT BACK TO CALL+1, CALL+2 OR CALL+3 / XTRVLN, TRVLIN /GO CHECK IF TRUE VERTICAL LINE PAGE /------------------------------------------------------------------------------ / LINE - CHECK IF LINE CAN BE DRAWN - CLIP LINE - SHADE TO Y - DRAW LINE /------------------------------------------------------------------------------ / LINE, 0 CLA CLL TAD XPOS1 DCA UNMODX TAD YPOS1 DCA UNMODY JMS I CHKLIN /GO CHECK FOR TYPE OF LINE AND SLOPE JMS I POSNEW /GO UPDATE POSITION TO FIRST DRAWING POSITION JMS I CHKLIN /GO CHECK FOR TYPE OF LINE AND SLOPE AGAIN TAD XPOS1 /GET THE "FROM" X POSITION DCA XTEMP1 /SAVE IT TAD YPOS1 /GET THE "FROM "Y" POSITION DCA YTEMP1 /SAVE IT TAD XPOS2 /GET THE "TO" X CO-ORDINATE DCA XTEMP2 /SAVE IT TAD YPOS2 /GET THE "TO" Y CO-ORDINATE DCA YTEMP2 /SAVE IT CLA CLL CMA RTL /INITIALIZE TRY COUNTER TO -3 DCA TRYCNT /SAVE THE COUNTER TRYAGN, JMS I XCKCLP /GO CHECK POSITION OF CO-ORDINATES JMP SHDLIN /ALL POINT ON SCREEN - GO CHECK IF SHADE OR LINE JMP LINOUT /POINTS TO LEFT,RIGHT,ABOVE OR BELOW SCREEN JMS I LINCLP /GO DO LINE CLIPPING TO SCREEN REGION SKP CLA /SLOPED LINE OFF SCREEN - INVISIBLE LINE JMP SHDLIN /CO-ORDINATES CLIPPED - GO CHECK IF SHADING / TAD SHDFLG /GET THE SHADE FLAG SNA CLA /SKIP IF SHADING IS ENABLED JMP NOLINE /LINE OFF THE SCREEN - EXIT LINE INVISIBLE ISZ TRYCNT /CHECK TO SEE IF THIRD TRY SKP CLA /SKIP IF NOT 3RD JMP NOLINE /LINE OFF SCREEN - CAN'T DRAW IT TAD XFLAG1 /CHECK IF X POS1 IS ON THE SCREEN SNA CLA /SKIP IF NOT JMP Y2INTR /IT IS - USE Y INTERCEPT VALUE FOR YPOS2 TAD XFLAG2 /CHECK IF XPOS2 ON THE SCREEN SZA CLA /SKIP IF IT IS JMP Y2INTR /IT ISN'T - USE Y INTERCEPT FOR YPOS2 TAD I EQ1SVX /GET XPOS1 ASSUMED INTERCEPT VALUE DCA XPOS1 /SAVE IT TAD I EQ1SVY /GET YPOS1 INTERCEPT VALUE DCA YPOS1 /SAVE IT JMP TRYAGN /GO TRY AGAIN - SHOULD RETURN TO LINOUT Y2INTR, TAD I EQ3SVX /GET XPOS2 ASSUMED INTERCEPT VALUE DCA XPOS2 /SAVE IT TAD I EQ3SVY /GET YPOS2 INTERCEPT VALUE DCA YPOS2 /SAVE IT JMP TRYAGN /GO TRY AGAIN - SHOULD RETURN TO LINOUT / LINOUT, TAD SHDFLG /GET THE SHADE FLAG SNA CLA /SKIP IF SHADING IS ENABLED JMP NOLINE /LINE TO LEFT,RIGHT,TOP OR BOTTOM OF SCREEN CLA CLL CMA RTL /-3 CHECK IF LINE TO LEFT OR RIGHT TAD LININD /GET THE LINE INDICATOR SPA /SKIP IF BEFORE OR AFTER SCREEN JMP NOLINE /LINE TO LEFT OR RIGHT - CAN NOT DRAW OR SHADE SZA CLA /SKIP IF LINE AFTER THE SCREEN JMS I XWMDSL /GET Y REFERENCE LINE OFFSET (0 OR -2) SGNCHK /ADD THE TWO NUMBERS CHECKING FOR OVERFLOW YREFLN /ADDRESS OF SECOND NUMBER TO ADD DCA YPOS2 /SAVE IT FAREA /GO DO AREA FILL JMP NOLINE /EXIT - SHADING COMPLETE FOR LINE OFF SCREEN / SHDLIN, JMS I CHKLIN /RECALCULTATE TYPE OF LINE TAD SHDFLG /GET THE SHADE FLAG SZA CLA /IS SHADE TO Y ENABLED JMP SHADIT /YES - GO SHADE TO Y REFERENCE LINE JMS I XDRWLN /GO DRAW THE LINE JMP NOLINE /GO RESTORE LAST POSITION OF LINE TO PRESENT SHADIT, JMS I DOSHDE /GO DO LINE SHADING - SHADE TO Y NOLINE, CLA CLL /CLEAN UP THE AC - NEEDED TAD XTEMP2 /GET THE SAVED "TO" X CO-ORDINATE DCA XPOS1 /SAVE AS PRESENT X TAD YTEMP2 /GET THE SAVED "TO" Y CO-ORDINATE DCA YPOS1 /SAVE AS PRESENT Y JMP I LINE /EXIT BACK TO CALLER / TRYCNT, 0 /NUMBER OF TRIES WHEN LINE OFF SCREEN (SHADE) CHKLIN, LINCHK /ROUTINE TO CHECK TYPE OF LINE AND SLOPE DIR POSNEW, NEWPOS /ROUTINE TO CALCULATE STARTING DRAWING POSITION XCKCLP, CHKCLP /ROUTINE TO CHECK CO-ORDINATES OF LINE LINCLP, LNSLOP /ROUTINE TO DO ACTUAL LINE CLIPPING XDRWLN, DRWLIN /ROUTINE TO DO ACTUAL LINE DRAWING DOSHDE, SHADE /ROUTINE TO SHADE TO Y REFERENCE EQ1SVX, EQ1ASX EQ1SVY, EQ1YL /ADDRESS OF EQ1 Y INTERCEPT POINT EQ3SVX, EQ3ASX EQ3SVY, EQ3YL /ADDRESS OF EQ3 Y INTERCEPT POINT YTEMP1, 0 /SAVED "FROM" Y CO-ORDINATE YTEMP2, 0 /SAVED "TO" Y CO-ORDINATE UNMODX, 0 UNMODY, 0 / /----------------------------------------------------------------------------- / WSHADL - CHOOSE WHICH SHADE LINE TO USE TO DRAW TO REFERENCE /------------------------------------------------------------------------------ / WSHADL, 0 TAD YREF /GET THE Y REFERENCE CLL RAR /DIVIDE IT BY 2 CIA /NEGATE IT FOR COMPARISONS LATER DCA NEGHYR /SAVE NEGATED YREF/2 JMS I Y12CHK /IF Y1/2 = Y2/2 THEN Y1=Y2 - SLOPE RETURNED SPA CLA /IS Y1/2 <= Y2/2 ? JMP SHADV2 /NO Y1/2 > Y2/2 - GO CHECK THESE POSITIONS TO YREF TAD NEGHYR /GET NEGATED YREF/2 - CHECK IF YREF/2 <= Y1/2 TAD I HLFYP1 /Y1/2 SMA CLA /IS YREF<=Y1 JMP SHADV1 /YES - SET "FROM" Y TO Y REFERENCE TAD NEGHYR /CHECK IF Y2/2 <= VREF/2 TAD I HLFYP2 / Y2/2 SMA SZA CLA /Y2 <= YREF ? JMP SHADVL /NO-GO DRAW VERTICAL LINE - IT CROSSES REFERENCE JMS I XWMDSL /GO GET Y REFERENCE LINE OFFSET (0 OR -2) SHADV4, TAD YREF / DCA YPOS2 /SET "TO" CO-ORDINATE TO REF OR REF -2 JMP SHADVL /GO DRAW VERTICAL LINE TO Y REFERENCE LINE SHADV2, TAD NEGHYR /CHECK IF Y1/2 <= YREF/2 TAD I HLFYP1 / Y1/2 SMA SZA CLA /IS Y1<=YREF ? JMP SHADV3 /NO - GO CHECK IF YREF<=Y2 JMS I XWMDSL /GO GET Y REFERNECE LINE OFFSET (0 OR -2) SHADV1, TAD YREF / DCA YPOS1 /SET "FROM" CO-ORDINATE TO REF OR REF -2 JMP SHADVL /GO DRAW VERTICAL LINE FROM Y REFERENCE SHADV3, TAD NEGHYR /CHECK IF YREF/2 <= Y2/2 TAD I HLFYP2 SMA CLA /IS YREF<=Y2 ? JMP SHADV4 /YES - SET "TO" CO-ORDINATE TO Y REFERENCE SHADVL, JMP I WSHADL /EXIT / XWMDSL, WMDSLN Y12CHK, CHKY12 NEGHYR, 0 HLFYP1, HALFY1 HLFYP2, HALFY2 PAGE /----------------------------------------------------------------------------- / SHADE - SHADE ALL LINES TO A Y REFERENCE LINE /-------------------------------------------------------------------------------- / SHADE, 0 JMS I XDHVLN /GO CHECK TYPE OF LINE AND WRITING MODE JMP SHADE1 /SLOPED LINE JMP I SHADE /VERTICAL LINE AND COMPLEMENT MODE EXIT TAD XTEMP1 /GET THE REAL "FROM" X POSITION DCA XPOS1 /SAVE IT TAD XTEMP2 /GET THE REAL "TO" X POSITION DCA XPOS2 /SAVE IT FAREA /DO AREA FILL OF HORIZONTAL,VERITCAL,DOT LINE JMP I SHADE /EXIT HORIZONTAL LINE OR DOT SHADING DONE / SHADE1, DCA MQLW /MULTIPLY DELTAY BY 4096 TAD SLPDYL / DCA MQHW /*4096 TAD SLPDYH / DCA ACLW /SIGN EXTENTION*4096 TAD SLPDYH /SIGN EXTEND THE SIGN EXTENTION SPA CLA /SKIP IF POSITIVE SLOPE CLA CMA /NEGATIVE SLOPE DCA ACHW /SAVE THE SIGN EXTENTION WORD DBLDIV /DIVDE DELTAY*4096/DELTAX SLPDXH /ADDRESS OF DELTAX TAD XDIF /GET THE X TRANSVERSAL DIRECTION SMA CLA /SKIP IF GOING RIGHT TO LEFT JMP SHADE3 /GOING LEFT TO RIGHT JMS I LCOMP /NEGATE THE SLOPE MQHW /ADDRESS OF QUOTIENT SHADE3, TAD MQHW /GET THE HIGH WORD OF QUOTIENT DCA LSLOPH /SAVE IT TAD MQLW /GET THE LOW WORD OF QUOTIENT DCA LSLOPL /SAVE IT / TAD YPOS1 /GET THE FIRST Y POSTION DCA YIH /SAVE AS Y1*4096 DCA YIL / TAD XPOS1 /GET THE STARTING X POSITION DCA XI /SAVE IT TAD YPOS1 /GET THE STARTING Y DCA YI /SAVE IT TAD XPOS2 /GET THE ENDING X POSITION ON THE SCREEN DCA ENDX /SACE IT FOR COMPARISONS / TAD XPOS1 /CHECK IF STARTING X = REAL STARTING X CIA TAD XTEMP1 /REAL X SNA CLA /ARE THEY EQUAL JMP SHADE5 /YES - THEN START SHADING WITH LINES HERE TAD XDIF /+/- X - UPDATE X SO THAT AREA FILL WON'T OVRLY CIA TAD XPOS1 /UPDATE X POSITION BY + OR - ONE DCA XPOS1 /SAVE THE UPDATED X POSITION TAD XTEMP1 /GET THE REAL X DCA XPOS2 /SAVE IT TAD YREF /GET THE Y REFERENCE LINE DCA YPOS2 /SAVE IT FAREA /GO DO AREA FILLING FOR PART OF LINE OFF SCREEN TAD XI /GET THE STARTING X DCA XPOS1 /RESTORE IT FOR LINE SHADING ON THE SCREEN / SHADE5, TAD YIH /SEUP "FROM" Y DCA YPOS1 TAD XPOS1 /SETUP "TO" X FROM THE "FROM" X DCA XPOS2 TAD YREF /SETUP "TO" Y DCA YPOS2 JMS I CHKREF /GO CHECK WHICH REFERENCE LINE TO DRAW TO FAREA /GO DRAW THE LINE TAD YIH /RESTORE Y POSITION 1 DCA YPOS1 TAD XPOS1 /CHECK IF DONE SHADING CIA TAD ENDX SNA CLA /SKIP IF MORE LINES TO SHADE JMP SHADE6 /GO FINISH THE SHADING WITH AREA FILLS TAD XPOS1 /GET THE PRESENT X POSITION TAD XDIF /UPDATE IT BY +1 OT -1 DCA XPOS1 /SAVE AS NEW X POSITION TAD YIH /SETUP FIRST WORD OF DOUBLE PRECISION ADD DCA ACHW TAD YIL DCA ACLW DBLADD /ADD YI + SLOPE LSLOPH /ADDRESS OF SECOND WORD TO ADD YIH /STORE RESULTS OF ADDITION IN THIS ADDRESS MINMAX YIH YIHFLG MINY MAXY TAD YIHFLG /CHECK UPDATED YIH TO STILL BE ON THE SCREEN SNA CLA /SKIP IF NOT JMP SHADE5 /GO DRAW THIS LINE AND CHECK IF DONE CLA CLL CMA /-1 ISZ YIHFLG /CHECK IF BEFORE THE SCREEN SKP CLA /BEFORE THE SCREEN - CLEAR THE AC TAD MAXY /RESET YIH TO THE BOUNDRY ISZ YIHFLG /NOW SKIP IF BEFORE THE SCREEN SKP TAD MINY /RESET TO BEGINNING OF THE SCREEN DCA YIH /RESTORE YIH TO THE SCREEN BOUNDRY JMP SHADE5 /GO DRAW THIS LINE AND CHECK IF DONE / SHADE6, TAD XPOS1 /CHECK IF ENDING SHADE X = REAL ENDING X CIA TAD XTEMP2 /REAL X SNA CLA /ARE THEY EQUAL JMP I SHADE /YES - EXIT COMPLETE LINE NOW DRAWN TAD XPOS1 /GET THE CURRENT X POSITION TAD XDIF /+/- X SO THAT AREA FILL WON'T OVERLAY LAST X DCA XPOS1 /SAVE IT TAD XTEMP2 /GET THE REAL ENDING X DCA XPOS2 /SAVE IT TAD YREF /GET THE Y REFERENCE LINE DCA YPOS2 /SAVE IT FAREA /GO DO AREA FILL FOR PART OF LINE OFF SCREEN JMP I SHADE / XDHVLN, DHVLIN /CHECK TYPE OF LINE AND WRITING MODE IF VERTICAL CHKREF, WSHADL /GO CHECK WHICH REFERENCE LINE TO SHADE TO YIHFLG, 0 LCOMP, COMP ENDX, 0 XI, 0 YI, 0 YIH, 0 YIL, 0 LSLOPH, 0 LSLOPL, 0 /------------------------------------------------------------------------------ / TRMNTE - TERMINATE GRAPHICS - SCREEN ERASED - CURSOR DISABLED - INIT SOFTWARE /------------------------------------------------------------------------------ / TRMNTE, 0 JMS I XPWRUP /DISABLE CURSOR - RESET TEXT AND GRAPHIC SCREENS JMS I XINIT /INIT SOFTWARE,CHAR SETS, AND CLEAR SCREEN JMP I TRMNTE /EXIT / XPWRUP, PWRUP /DISABLE CURSOR - HARDWARE RESET XINIT, INIT /INITIALIZE GRAPHICS SOFTWARE PAGE /----------------------------------------------------------------------------- / DRWLIN - SETUP GDC LINE DRAWING PARAMETERS AND DRAW THE LINE /----------------------------------------------------------------------------- / DRWLIN, 0 TAD YPOS1 /GET THE 1ST LOGICAL Y CO-ORDINATE OF LINE CLL RAR /DIVIDE IT BY TWO DCA PYPOS1 /SAVE AS PHYSICAL Y CO-ORDINATE TAD YPOS2 /GET THE 2ND LOGICAL Y CO-ORDINATE OF LINE CLL RAR /DIVIDE IT BY TWO DCA PYPOS2 /SAVE AS PHYSICAL Y CO-ORDINATE BLDPOS /CREATE POSITION CURSOR STRING SPOSIT / / CREATE THE FIGS STRING / TAD PSLINE /GET ADDRESS OF STRING DCA AUTO10 TAD XPOS1 /DELTAX = XPOS2 - XPOS1 CIA TAD XPOS2 DCA DELTAX TAD PYPOS1 /DELTAY = YPOS2 - YPOS1 CIA TAD PYPOS2 DCA DELTAY TAD DELTAX /CHECK IF RIGHT OR LEFT FOR OCTANT SELECTION SMA CLA AC1 /BIT <11> SET/RESET ACCORDINGLY DCA OFFSET TAD DELTAY /CHECK IF UP OR DOWN FOR OCTANT SELECTION SPA CLA /(DOWN IS +Y, REMEMBER) AC0002 /BIT <10> SET/RESET ACCORDINGLY TAD OFFSET DCA OFFSET TAD DELTAX /ABS(DELTAX) SPA CIA DCA DELTAX TAD DELTAY /ABS(DELTAY) SPA CIA DCA DELTAY TAD DELTAY /ABS(DELTAX) - ABS(DELTAY) CIA TAD DELTAX DCA DIFABS TAD DIFABS /CHECK IF STEEP OR GRADUAL FOR OCTANT SELECTION SMA CLA AC0004 /BIT <09> SET/RESET ACCORDINGLY TAD OFFSET DCA OFFSET TAD DIFABS /DETERMINE INDEPENDENT AXIS (LARGER OF X OR Y) SMA CLA JMP LINE2 /GO DO X AS INDEPENDENT AXIS TAD DELTAY /DO Y AS INDEPENDENT AXIS DCA DELTAI TAD DELTAX DCA DELTAD JMP LINE4 LINE2, TAD DELTAX /DO X AS INDEPENDENT AXIS DCA DELTAI TAD DELTAY DCA DELTAD LINE4, TAD POCTAN /DETERMINE OCTANT FROM DIRECTIONS TAD OFFSET DCA OFFSET /GETS THE ADDRESS OF OCTANT NUMBER TAD I OFFSET /GETS THE OCTANT NUMBER TAD K0010 /MAKES A 'LINE' COMMAND DCA I AUTO10 /SAVE AS P1 TAD DELTAI /SAVE ABS(DELTAI) AS P2 AND P3 (DC) JMS I LSAVDX TAD DELTAD /SAVE 2*ABS(DELTAD) - ABS(DELTAI) CLL RAL / AS P4 AND P5 (D) CIA TAD DELTAI CIA JMS I LSAVDX TAD DELTAI /SAVE 2*(ABS(DELTAD) - ABS(DELTAI)) CIA / AS P6 AND P7 (D2) TAD DELTAD CLL RAL JMS I LSAVDX TAD DELTAD /SAVE 2*(ABS(DELTAD)) AS P8 AND P9 (D1) CLL RAL JMS I LSAVDX / / DRAW THE LINE / DRAWIT /DRAW A LINE SPOSIT / AT THIS POSITION SLINE / AS A LINE LINPAT / CLA CLL JMP I DRWLIN /RETURN / LSAVDX, SAVEDX PSLINE, SLINE POCTAN, OCTANT OCTANT, 7; 0; 4; 3; 6; 1; 5; 2 DELTAX, 0 DELTAY, 0 DELTAI, 0 DELTAD, 0 OFFSET, 0 DIFABS, 0 / SAVCUR, 0 /SAVE PRESENT CURSOR POSITION (SCREEN DUMP) TAD XPOS1 /GET THE PRESENT X POSITION DCA SAVX1 /SAVE IT TAD YPOS1 /GET THE PRESENT Y POSITION DCA SAVY1 /SAVE IT JMP I SAVCUR /EXIT PRESENT CURSOR POSITION SAVED CURRST, 0 /RESTORE PRESENT CURSOR POSITION (SCREEN DUMP) TAD SAVX1 /GET THE CURSOR X POSITION SAVED DCA XPOS1 /RESTORE THE X POSITION TAD SAVY1 /GET THE CURSOR Y POSITION SAVED DCA YPOS1 /RESTORE THE Y POSITION JMP I CURRST /EXIT CURSOR POSITION RESTORED / SAVX1, 0 SAVY1, 0 / SSET, 443; 7777 /WDAT COMMAND FOR 'SET' SCLEAR, 442; 7777 /WDAT COMMAND FOR 'RESET' SCOMP, 441; 7777 /WDAT COMMAND FOR 'COMP' / / TABLE OF THE LOGICAL SCREEN REGION CO-ORDINATES / LREGIN, SRNLHX /LEFT HORIZONTAL X SRNUVY /UPPER VERTICAL Y SRNRHX-1 /RIGHT HORIZONTAL X SRNLVY-1 /LOWER VERTICAL Y PAGE /----------------------------------------------------------------------------- / ARCLIP - ROUTINE TO DO CLIPPING OF X AND Y CO-ORDINATES FOR AREA FILLS /----------------------------------------------------------------------------- ARCLIP, 0 JMS I ACKCLP /CHECK IF CLIPPING OF CO-ORDINATES NEEDED JMP AREXIT /ALL POINTS ON SCREEN - GO CHECK DIRECTION JMP AREANO /AREA OFF THE SCREEN - CAN'T DO AREA FILL JMS I XVCLP /GO DO VERTICAL CLIPPING IF NEEDED JMS I XHCLP /GO DO HORIZONTAL CLIPPING IF NEEDED AREXIT, ISZ ARCLIP /BUMP RETURN TO DO AREA FILL / TAD XPOS2 /CHECK IF XPOS2 > XPOS1 CIA TAD XPOS1 SPA CLA /SKIP IF XPOS1 >= XPOS2 JMP ARYCHK /VALUES IN CORRECT SEQUENCE - GO CHECK Y VALUES TAD XPOS2 /EXCHANGE XPOS2 WITH XPOS1 DCA TEMPAR /SAVE XPOS2 TAD XPOS1 DCA XPOS2 /XPOS2 GET VALUE OF XPOS1 TAD TEMPAR DCA XPOS1 /XPOS1 GET VALUE OF XPOS2 ARYCHK, JMS I ACKREF /GO CHECK SHADING AND REFERENCE LINE TAD YPOS2 /CHECK IF YPOS2 > YPOS1 CIA TAD YPOS1 SMA CLA /SKIP IF YPOS2 > YPOS1 JMP AREANO /VALUES IN CORRECT SEQUENCE - GO DO AREA FILL TAD YPOS2 /EXCHANGE YPOS2 WITH YPOS1 DCA TEMPAR /SAVE YPOS2 TAD YPOS1 DCA YPOS2 /YPOS2 GET VALUE OF YPOS1 TAD TEMPAR DCA YPOS1 /YPOS1 GET VALUE OF YPOS2 / AREANO, JMP I ARCLIP /HERE IF NO AREA FILL TO BE DONE - RETURN CALL +1 / XVCLP, VCLIP /VERTICAL LINE CLIPPING ROUTINE XHCLP, HCLIP /HORIZONTAL LINE CLIPPING ROUTINE ACKCLP, CHKCLP /ROUTINE TO CHECK IF CLIPPING NEEDED ACKREF, REFACK TEMPAR, 0 /----------------------------------------------------------------------------- / NEWPOS - CALCULATE FIRST DRAWING POSITION FOR LINE /-------------------------------------------------------------------------------- / NEWPOS, 0 TAD SHDFLG /GET THE SHADE FLAG SNA CLA /SKIP IF SET JMP GTNWPS /GO GET NEXT DRAWING POSITION CLA CLL CMA RAL /-2 TAD WRMODE /GET THE CURRENT WRITING MODE SNA CLA /SKIP IF WRITING MODE NOT COMPLEMENT MODE JMP GTNWPS /COMPLEMENT MODE - GET NEXT DRAWING POSITION ISZ NEWPOS /UPDATE POINTER - NO NEED TO CHECK LINE AGAIN JMP I NEWPOS /EXIT TO CALLER +2 GTNWPS, TAD SLPOFS /GET THE LINE TYPE AND SLOPE INDICATOR TAD MM0006 /CHECK IF THE LINE IS A DOT SNA /SKIP IF NOT A DOT JMP I NEWPOS /A DOT EXISTS - USE THIS AS DRAWING POSITION IAC /UPDATE LINE TYPE INDICATOR SZA /IS THE LINE A HORIZONTAL LINE JMP NWPOS0 /NO - GO CHECK IF VERTICAL LINE NEWPS, CLA /NEEDED FOR ANOTHER ENTRANCE FROM SAME ROUTINE TAD XPOS1 /YES - GET PRESENT STARTING X POSITION TAD XDIF /GET THE TRAVERSING X OFFSET DCA XPOS1 /SAVE THIS AS THE NEW STARTING X POSITION JMP I NEWPOS /EXIT - STARTING X POSITION UPDATED NWPOS0, IAC /UPDATE THE LINE TYPE INDICATOR SZA CLA /IS THE LINE A VERTICAL LINE ? JMP NWPOS3 /NO - THEN A SLOPED LINE NEED Y INTERCEPT NWPOS1, JMS I NWPOSY /GO UPDATE THE Y POSITION BY 1 OR 2 JMP I NEWPOS /EXIT NWPOS3, TAD SHDFLG /GET THE SHADE FLAG SZA CLA /IS SHADING TURNED ON JMP NWPOS6 /YES - GO CALCULATE Y INTERCEPT TAD SLPDXH /SETUP TO DO DELTAX-DELTAY SUBRACTION DCA ACHW / TAD SLPDXL / DCA ACLW / TAD ACHW /GET DELTAX VALUE SAVED SMA CLA /IS IT NEGATIVE JMP NWPOS4 /NO - GO GET DELTAY/2 JMS I NPCOMP /YES - MAKE IT ABSOLUTE ACHW NWPOS4, CLA CLL /DIVIDE DELTAY BY 2 MAINTAING THE SIGN TAD SLPDYH /GET THE HIGH WORD OF DELTAY SPA /SKIP IF WORD POSITIVE LINK ALREADY CLEARED CML /REPLICATE THE NEGATIVE SIGN BIT RAR /DIVIDE HIGH WORD BY 2 - LINK = LSB DCA NWPSYH /SAVE THIS AS NEW HIGH WORD/2 TAD SLPDYL /GET THE LOW WORD OF DELTAY RAR /DIVIDE IT BY 2 - LSB IS LOST DCA NWPSYL /SAVE THIS AS FINAL DELTAY/2 TAD NWPSYH /GET DELTAY/2 HIGH WORD SMA CLA /IS IT NEGATIVE JMP NWPOS5 /NO - GO SUBTRACT DELTAY FROM DELTAX JMS I NPCOMP /MAKE DELTAY POSITIVE NWPSYH NWPOS5, DBLSUB /SUBRACT DELTAY FROM DELTAX (DELTAX-DELTAY) NWPSYH /ADDRESS OF WORD TO BE SUBRACTED NWPSYH /ADDRESS OF WHERE TO STORE RESULTS TAD NWPSYH /GET THE HIGH WORD OF THE SUBTRACTION SMA SZA /DELTAY >= DELTAX JMP NEWPS /NO - GO INCREASE X POSITON SZA CLA /SKIP IF DELTA X COULD = DELTA Y JMP NWPOS1 /HIGH WORD INDICATES DELTAX < DELTAY TAD NWPSYL /CHECK THE LOW WORD TO MAKE SURE SZA CLA /SKIP IF DELTA X = DELTAY JMP NEWPS /LOW WORD INDICATES DELTAX > DELTAY TAD XPOS1 /UPDATE THE X POSITION BY 1 TAD XDIF / DCA XPOS1 /SAVE THE UPDATED X POSITION JMP NWPOS1 /GO UPDATE THE Y POSITION BY + OR - 2 NWPOS6, TAD XPOS1 /GET THE STARTING X POSITION TAD XDIF /UPDATE IT BY + OR - ONE DCA NWPOSX /SAVE IT FOR CALCULATING THE Y INTERCEPT JMS I POSEQY /GO CALCULATE THE Y INTERCEPT OF THIS LINE XPOS1 /STARTING X POSITION YPOS1 /STARTING Y POSITION NWPOSX, 0 /ASSUMED X NWPSYH, 0 /CALCULATED Y INTERCEPT HIGH WORD NWPSYL, 0 /CALCULATED Y INTERCEPT LOW WORD 0 /EQUATIONS FLAG WORD TAD NWPOSX /GET THE NEW X DCA XPOS1 /SAVE THE UPDATED X TAD XPOS1 /CHECK TO SEE IF XPOS1 =XPOS2 CIA TAD XPOS2 / SNA CLA /ARE THEY EQUAL ? JMP NWPOS1 /YES - GO UPDATE Y BY 1 OR 2 TAD NWPSYL /GET THE Y INTERCEPT VALUE CALCULATED DCA YPOS1 /SAVE AS THE NEW STARTING Y POSITION JMP I NEWPOS /EXIT BACK TO CALLING ROUTINE / POSEQY, EQ1 NPCOMP, COMP /2'S COMPLEMENT 2 WORD SIGNED NUMBER MM0006, -0006 NWPOSY, POSYNW /ROUTINE TO UPDATE Y BY 1 OR 2 PAGE /----------------------------------------------------------------------------- / CHKCLP - ROUTINE TO CHECK IF CLIPPING NEEDED / RETURN CALL +1 - ALL POINTS ON THE SCREEN / RETURN CALL +2 - POINTS TO LEFT,RIGHT,ABOVE OR BELOW SCREEN (INVISIBLE) / RETURN CALL +3 - CLIPPING OF POINTS TO SCREEN BOUNDRY NEEDED /----------------------------------------------------------------------------- CHKCLP, 0 DCA LININD /INDICATE THAT ALL POINTS ON SCREEN MINMAX /GO CHECK FINAL X CO-ORDINATE XPOS2 /CO-ORDINATE ADDRESS XFLAG2 /RETURN VALUE (-2 < MIN) (-1 > MAX) (0=VALID) MINX /ADDRESS OF MINIMUM X CO-ORDINATE ALLOWED MAXX /ADDRESS OF MAXIMUM X CO-ORDINATE ALLOWED +1 MINMAX /GO CHECK FINAL Y CO-ORDINATE YPOS2 /CO-ORDIANTE ADDRESS YFLAG2 /RETURN VALUE (-2 < MIN) (-1 > MAX) (0=VALID) MINY /ADDRESS OF MINIMUM Y CO-ORDIANTE ALLOWED MAXY /ADDRESS OF MAXIMUM Y CO-ORDINATE ALLOWED +1 CHKXY1 /CHECK STARTING POINTS - FLAGS RETURNED IN AC TAD XFLAG2 /ADD ENDING POINT FLAGS TO STARTING POINT TAD YFLAG2 / SNA CLA /SKIP IF NOT ON SCREEN JMP CLPEXT /GO DO THE LINE - POINTS ARE VALID AC0004 /CHECK IF LINE ON LEFT OF SCREEN TAD XFLAG1 / TAD XFLAG2 / SNA /SKIP IF NOT ON LEFT SIDE OF SCREEN JMP LNLEFT /LINE ON LEFT - CAN NOT DRAW IT CLL RTR /CHECK IF LINE ON RIGHT OF SCREEN SZA CLA /SKIP IF POINTS MAY BE ON RIGHT SIDE JMP CLIPVT /POINTS NOT ON RIGHT - DO FURTHER CHECKING TAD XFLAG1 /CHECK IF XPOS1 ON SCREEN SNA CLA /SKIP IF NOT JMP CLIPVT /ONE POINT ON AND ONE POINT BEFORE TAD XFLAG2 /CHECK IF XPOS2 ON SCREEN SZA CLA /SKIP IF ONE POINT ON AND ONE POINT OFF JMP LNRGHT /BOTH POINTS ON RIGHT SIDE OF SCREEN CLIPVT, AC0004 /CHECK IF LINE BEFORE TOP OF SCREEN TAD YFLAG1 / TAD YFLAG2 / SNA /SKIP IF NOT BEFORE TOP OF SCREEN JMP LNBFOR /LINE BEFORE TOP - CAN NOT DRAW IT CLL RTR /CHECK IF LINE BEYOND BOTTOM OF SCREEN SZA CLA /SKIP IF BOTH POINTS COULD BE BEYOND BOTTOM JMP LNCLPN /CONTINUE BOTH POINTS ARE NOT BEYOND BOTTOM TAD YFLAG1 /CHECK IF YPOS1 BEYOND BOTTOM SNA CLA /SKIP IF BEYOND OR BEFORE BOTTOM JMP LNCLPN /ONE POINT ON AND ONE POINT OFF SCREEN - CONT TAD YFLAG2 /CHECK IF THIS POINT ON OR OFF SCREEN SZA CLA /SKIP IF POINT ON SCREEN JMP LNAFTR /BOTH POINTS BEYOND BOTTOM OF SCREEN / LNCLPN, ISZ LININD /CLIPPING OF THE LINE NEEDED 5 LNBFOR, ISZ LININD /LINE BEFORE THE SCREEN 4 LNAFTR, ISZ LININD /LINE AFTER THE SCREEN 3 LNRGHT, ISZ LININD /LINE RIGHT OF SCREEN 2 LNLEFT, ISZ LININD /LINE LEFT OF SCREEN 1 TAD LININD /GET THE LINE INDICATOR TAD MM0005 /CHECK IF CLIPPING NEEDED OR LINE INVISIBLE SNA CLA /SKIP IF LINE INVISIBLE ISZ CHKCLP /CLIPPING NEEDED ISZ CHKCLP /LINE INVISIBLE CLPEXT, JMP I CHKCLP /LINE VALID ON SCREEN 0 / / MM0005, -0005 /----------------------------------------------------------------------------- / HCLIP/VCLIP - ROUTINES TO DO HORIZONTAL AND VERTICAL CLIPPING OF LINES/AREAS /----------------------------------------------------------------------------- / HCLIP, 0 TAD HCLIP /GET CALLING ADDRESS DCA VCLIP /SAVE FOR RETURN TAD AHCTBL /GET ADDRESS OF HORIZONTAL CLIPPING TABLE JMP HVCLIP /GO DO HORIZONTAL LINE CLIPPING / VCLIP, 0 TAD AVCTBL /GET ADDRESS OF VERTICAL CLIPPING TABLE HVCLIP, DCA HVTMP1 /SAVE THE ADDRESS OF THE TABLE CLA CLL CMA RAL /SETUP TO DO TWO SETS OF X OR Y CO-ORDINATES DCA HVTMP4 /SAVE THE LOOP COUNTER HVCLP1, TAD M0004 /SETUP TO MOVE 4 ENTRIES FROM TABLE DCA HVTMP3 /SAVE THE MOVE COUNTER TAD AHVFLG /GET THE ADDRESS OF BUFFER FOR DATA DCA HVTMP2 /SAVE THE ADDRESS OF THE BUFFER HVCLP2, TAD I HVTMP1 /GET ADDRESS FROM THE TABLE DCA I HVTMP2 /SAVE IN WORKING BUFFER ISZ HVTMP1 /UPDATE THE TABLE AND BUFFER POINTERS ISZ HVTMP2 / ISZ HVTMP3 /DONE ALL 4 MOVES? JMP HVCLP2 /NO - MOVE THE NEXT WORD / TAD I HVFLG /GET THE X OR Y POSITIONS FLAG SNA /CHECK IF POINT IS ON THE SCREEN JMP HVCLP4 /YES - THIS POINT ON THE SCREEN - EXIT IAC /CHECK IF BEYOND THE SCREEN SZA CLA /IF 0 THEN BEYOND THE BOTTOM OF SCREEN JMP HVCLP3 /CO-ORDINATE BEFORE THE SCREEN CLA CLL CMA /SUBTRACT 1 FROM MAXIMUM CO-ORDINATE TAD I HVMAX /GET MAXIMUM ALLOWED +1 SKP /GO SAVE AS NEW CO-ORDINATE HVCLP3, TAD I HVMIN /GET THE MINIMUM ALLOWED CO-ORDINATE DCA I HVPOS /SAVE THIS AS NEW CO-ORDINATE / HVCLP4, ISZ HVTMP4 /DONE BOTH SETS OF CO-ORDINATES JMP HVCLP1 /NO DO NEXT CO-ORDINATE JMP I VCLIP /RETURN BACK TO CALLING ROUTINE / HVTMP1, 0 /HORIZONTAL OR VERTICAL TABLE POINTER HVTMP2, 0 /BUFFER POINTER TO WORKING VARIABLES HVTMP3, 0 /WORD MOVE COUNTER HVTMP4, 0 /CO-ORDINATE SET COUNTER / HVFLG, 0 /X OR Y SCREEN POSITION FLAG ADDRESS HVPOS, 0 /X OR Y CO-ORDINATE ADDRESS HVMIN, 0 /X OR Y MINIMUM ALLOWED CO-ORDINATE ADDRESS HVMAX, 0 /X OR Y MAXIMUM ALLOWED CO-ORDINATE ADDRESS / / HCTBL, XFLAG1 XPOS1 MINX MAXX XFLAG2 XPOS2 MINX MAXX / VCTBL, YFLAG1 YPOS1 MINY MAXY YFLAG2 YPOS2 MINY MAXY AHCTBL, HCTBL AVCTBL, VCTBL AHVFLG, HVFLG /------------------------------------------------------------------------------ / GTLTXT - GET THE LINE TEXTURE - COPY OR REPLICATE BYTE TO TWO BYTES /------------------------------------------------------------------------------- / GTLTXT, 0 JMS I XGTPAT /GET LINE TEXTURE AND DO MIRROR IMAGE OF IT DCA LINTXT /SAVE THE LINE TEXTURE PATTERN JMS I XUPDPA /GO UPDATE THE LINE DRAWING PATTERN JMP I GTLTXT /EXIT BACK TO CALLER / XGTPAT, GETPAT /GET MIRROR IMAGE OF SPECIFIED LINE TEXTURE XUPDPA, UPDPAT PAGE /----------------------------------------------------------------------------- / LNSLOP - ROUTINE TO DO CLIPPING OF X AND Y CO-ORDINATES FOR SLOPPED LINES /----------------------------------------------------------------------------- LNSLOP, 0 CLA CLL DCA INVISB /INITIALIZE LINE TO BE VISIBLE TAD MMM006 /SETUP TO CHECK WHICH TYPE OF LINE (6-0) TAD SLPOFS /GET THE LINE INDICATOR AND SLOPE FLAG SZA /SKIP IF A DOT JMP RTSLP1 /NOT A DOT - CHECK IF HORIZONTAL LINE JMS I XHCLIP /GO DO HORIZONTAL LINE CLIPPING JMS I XVCLIP /GO DO VERTICAL LINE CLIPPING JMP EXSLOP /EXIT THE CLIPPING ROUTINE RTSLP1, IAC / SZA /CHECK IF LINE A HORIZONTAL LINE JMP RTSLP2 /NOT HORIZONTAL - GO CHECK IF VERTICAL JMS I XHCLIP /GO DO HORIZONTAL LINE CLIPPING JMP EXSLOP /EXIT THE CLIPPING ROUTINE RTSLP2, IAC / SZA /CHECK IF LINE A VERTICAL LINE JMP RTSLP3 /NOT A VERTICAL LINE - GO CHECK SLOPES JMS I XVCLIP /GO DO VERTICAL LINE CLIPPING JMP EXSLOP RTSLP3, IAC / SZA /LINE UPWARDS TO THE RIGHT ? JMP RTSLP4 /NO TAD MINX DCA I EQ1VAL /SAVE 1ST POSSIBLE INTERSECTION POINT X1,Y1 CLA CMA TAD MAXY DCA I EQ2VAL /SAVE 2ND POSSIBLE INTERSECTION POINT X1,Y1 CLA CMA TAD MAXX DCA I EQ3VAL /SAVE 1ST POSSIBLE INTERSECTION POINT OF X2,Y2 TAD MINY DCA I EQ4VAL /SAVE 2ND POSSIBLE INTERSECTION POINT OF X2,Y2 JMP CHKSLP /GO CALCULATE AND CHECK NEW SLOPE CO-ORDINATES RTSLP4, IAC SZA /LINE UPWARD AND TO THE LEFT JMP RTSLP5 /NO CLA CMA TAD MAXX DCA I EQ1VAL /SAVE 1ST POSSIBLE INTERSECTION POINT OF X1,Y1 CLA CMA TAD MAXY DCA I EQ2VAL /SAVE 2ND POSSIBLE INTERSECTION POINT OF X1,Y1 TAD MINX DCA I EQ3VAL /SAVE 1ST POSSIBLE INTERSECTION POINT OF X2,Y2 TAD MINY DCA I EQ4VAL /SAVE 2ND POSSIBLE INTERSECTION POINT OF X2,Y2 JMP CHKSLP /GO CALCULATE AND CHECK NEW SLOPE CO-ORDINATES / RTSLP5, IAC SZA CLA /LINE DOWNWARD TO THE RIGHT JMP RTSLP6 /NO - MUST BE DOWNWARD TO THE LEFT TAD MINX DCA I EQ1VAL /SAVE 1ST POSSIBLE INTERSECTION POINT OF X1,Y1 TAD MINY DCA I EQ2VAL /SAVE 2ND POSSIBLE INTERSECTION POINT OF X1,Y1 CLA CMA TAD MAXX DCA I EQ3VAL /SAVE 1ST POSSIBLE INTERSECTION POINT OF X2,Y2 CLA CMA TAD MAXY DCA I EQ4VAL /SAVE 2ND POSSIBLE INTERSECTION POINT OF X2,Y2 JMP CHKSLP /GO CALCULATE AND CHECK NEW SLOPE CO-ORDINATES RTSLP6, CLA CMA /LINE DOWNWARD TO LEFT TAD MAXX DCA I EQ1VAL /SAVE 1ST POSSIBLE INTERSECTION POINT OF X1,Y1 TAD MINY DCA I EQ2VAL /SAVE 2ND POSSIBLE INTERSECTION POINT OF X1,Y1 TAD MINX DCA I EQ3VAL /SAVE 1ST POSSIBLE INTERSECTION POINT OF X2,Y2 CLA CMA TAD MAXY DCA I EQ4VAL /SAVE 2ND POSSIBLE INTERSECTION POINT OF X2,Y2 CHKSLP, TAD XPOS1 /SAVE XPOS1 INCASE INVISIBLE LINE DCA RTSLX1 / TAD YPOS1 /SAVE YPOS1 INCASE OF INVISIBLE LINE DCA RTSLY1 / TAD XPOS2 /SAVE XPOS2 INCASE INVISIBLE LINE DCA RTSLX2 / TAD YPOS2 /SAVE YPOS2 INCASE INVISIBLE LINE DCA RTSLY2 / / JMS I NEWXYS /GO CALCULATE NEW X AND Y CO-ORDINATES / EXSLOP, TAD INVISB /GET THE INVISABLE FLAG SNA /SKIP IF THE LINE WAS INVISIBLE ISZ LNSLOP /VALID LINE - UPDATE RETURN POINTER SNA CLA JMP I LNSLOP /EXIT - POINTS HAVE BEEN CLIPPED TAD RTSLX1 /RESTORE ORIGINAL X POSITION 1 DCA XPOS1 TAD RTSLY1 /RESTORE ORIGINAL Y POSITION 1 DCA YPOS1 TAD RTSLX2 DCA XPOS2 TAD RTSLY2 DCA YPOS2 JMP I LNSLOP /RETURN - CO-ORDINATES CLIPPED IF NECCESSARY / MMM006, -0006 INVISB, 0 NEWXYS, CALXYS XHCLIP, HCLIP XVCLIP, VCLIP RTSLX1, 0 RTSLY1, 0 RTSLX2, 0 RTSLY2, 0 EQ1VAL, EQ1ASX EQ2VAL, EQ2ASY EQ3VAL, EQ3ASX EQ4VAL, EQ4ASY / REFACK, 0 TAD SHDFLG /IS SHADING TURNED ON SZA CLA /SKIP IF NOT JMS I XWSHDL /GO CHECK TO SEE WHICH REFERNECE LINE JMP I REFACK / XWSHDL, WSHADL / POSYNW, 0 /UPDATE CURRENT Y POSITION BY 1 OR 2 CLA CLL CMA RAL /SETUP TO ADD TO STARTING Y POSITION TWICE DCA INVISB /SAVE COUNTER IN TEMPORARY LOCATION NWPOS2, TAD YPOS1 /GET THE PRESENT Y POSITION TAD YDIF /GET THE TRAVERSING Y POSITION DCA YPOS1 /SAVE THE UPDATED Y POSITION TAD YPOS1 /CHECK THAT Y1 DOESN'T EXCEED Y2 CIA TAD YPOS2 SNA CLA /IS Y1 = Y2 JMP I POSYNW /YES THEN EXIT CAN'T UPDATE PAST ISZ INVISB /DONE UPDATING STARTING Y POSITION JMP NWPOS2 /NO - UPDATE Y ONCE MORE JMP I POSYNW /EXIT - STARTING Y POSITION UPDATED PAGE /----------------------------------------------------------------------------- / EQ1 - SOLVE Y GIVEN X FOR POINTS X1,Y1 - Y = ((DELTAY*NEW DELTA X)/DELTAX)+Y1 /----------------------------------------------------------------------------- EQ1, 0 TAD I EQ1 /GET THE STARTING/ENDING X POSITION DCA EQ1X12 /SAVE IT ISZ EQ1 /UPDATE POINTER TAD I EQ1 /GET THE STARTING/ENDING Y POSITION DCA EQ1Y12 /SAVE IT ISZ EQ1 /UPDATE POINTER TAD I EQ1 /GET MIN OR MAX LOGICAL X DCA EQX1 /SAVE THIS AS POSSIBLE NEW X1 ISZ EQ1 /UPDATE POINTER TO WHERE 2 WORD Y TO BE SAVED TAD EQ1 /GET ADDRESS OF WHERE HIGH Y IS TO BE SAVED DCA I EQOVAD /SAVE THE ADDRESS ISZ EQ1 /UPDATE POINTER TO LOW WORD OF SAVED Y TAD EQ1 /GET ADDRESS OF WHERE LOW Y IS TO BE SAVED DCA EQ1MD6 /SAVE ADDRESS FOR MINMAX CHECKING ISZ EQ1 /MOVE POINTER TO FLAG WORD TAD EQ1 /GET ADDRESS OF FLAG WORD DCA EQ1MD7 /SAVE FLAG WORD ADDRESS ISZ EQ1 /UPDATE POINTER FOR RETURN CLA CLL IAC /INITILAIZE FLAG - NUMBER TO LARGE DCA I EQ1MD7 /SAVE THE FLAG WORD TAD EQ1TAB /GET ADDRESS-1 OF EQUATION 1'S OVERLAY TABLE JMS I EQOVRL /GO OVERLAY ADDRESSES IN EQUATION 1 CNVDBL /CONVERT XPOS1 TO DOUBLE PRECISION WORD EQ1X12, XPOS1 /ADDRESS OF WORD TO BE CONVERTED EQ1MD1, EQ1YH /ADDRESS OF WHERE TO STORE WORD CNVDBL /CONVERT ASSUMED X TO DOUBLE PRECISION EQX1 /ADDRESS OF WORD TO BE CONVERTED ACHW /WHERE TO STORE IT - SETUP FOR SUBTRACTION DBLSUB /NEW DELTAX = (ASSUMED X - XPOS1) EQ1MD2, EQ1YH /ADDRESS OF WORD TO BE SUBTRACTED EQ1MD3, EQ1YH /WHERE TO STORE RESULTS OF SUBTRACTION DBLMTY /DELTAY * NEW DELTAX SLPDYH /ADDRESS OF 2 WORD MULTIPLICAND EQ1MD4, EQ1YH /ADDRESS OF 2 WORD MULTIPLIER DBLDIV /(DELTAY*NEW DELATAX)/DELTAX SLPDXH /ADDRESS OF DOUBLE WORD DIVISOR CNVDBL /CONVERT YPOS1 TO DOUBLE PRECISION WORD EQ1Y12, YPOS1 /ADDRESS OF WORD TO BE CONVERTED ACHW /WHERE TO STORE WORD - SETUP FOR ADDITION DBLADD /Y=Y1+(DELTAY*NEW DELTAX)/DELTAX MQHW /ADDRESS OF QUOTIENT FROM DIVISION EQ1MD5, EQ1YH /STORE RESULTS OF ADDITION AT THIS ADDRESS TAD I EQ1MD5 /GET THE HIGH WORD OF CALCULATED Y SZA CLA /SKIP IF NUMBER < 4096 AND NOT NEGATIVE JMP EQ1RET /NUMBER TO BIG OR NEGATIVE TAD I EQ1MD6 /GET THE LOW WORD OF CALCULATED Y SPA CLA /SKIP IF <= 2047 JMP EQ1RET /NUMBER TO BIG MINMAX /GO VALIDATE NEW Y POINT CALCULATED EQ1MD6, EQ1YL EQ1MD7, EQ1FLG MINY MAXY EQ1RET, CLA CLL /NEEDED TO CLEAN UP THE AC ON EXIT JMP I EQ1 /EXIT BACK TO CHECK NEXT SET OF POINTS / EQOVAD, OVRADR EQOVRL, OVRLAY EQ1TAB, EQ1TBL-1 EQ2TAB, EQ2TBL-1 /----------------------------------------------------------------------------- / EQ2 - ASSUME Y CALCULATE X FOR X1,Y1 - X = ((DELTAX*NEW DELTA Y)/DELTAY)+X1 /----------------------------------------------------------------------------- EQ2, 0 TAD I EQ2 /GET THE STARTING/ENDING X POSITION DCA EQ2X12 /SAVE IT ISZ EQ2 /UPDATE POINTER TAD I EQ2 /GET THE STARTING/ENDING Y POSITION DCA EQ2Y12 /SAVE IT ISZ EQ2 /UPDATE POINTER TAD I EQ2 /GET MIN OR MAX ASSUMED Y DCA EQY1 /SAVE AS POSSIBLE NEW Y ISZ EQ2 /UPDATE POINTER TO ADDRESS OF WHERE TO STORE X TAD EQ2 /GET ADDRESS OF WHERE HIGH X IS TO BE SAVED DCA I EQOVAD /SAVE THE ADDRESS ISZ EQ2 /UPDATE POINTER TO LOW WORD OF SAVED X TAD EQ2 /GET ADDRESS OF WHERE LOW X IS TO BE SAVED DCA EQ2MD6 /SAVE ADDRESS FOR MINMAX CHECKING ISZ EQ2 /MOVE POINTER TO FLAG WORD TAD EQ2 /GET ADDRESS OF FLAG WORD DCA EQ2MD7 /SAVE FLAG WORD ADDRESS ISZ EQ2 /UPDATE POINTER FOR RETURN CLA CLL IAC /INITILAIZE FLAG - NUMBER TO LARGE DCA I EQ2MD7 /SAVE THE FLAG WORD TAD EQ2TAB /GET ADDRESS-1 OF EQUATION 1'S OVERLAY TABLE JMS I EQOVRL /GO OVERLAY ADDRESSES IN EQUATION 1 CNVDBL /CONVERT YPOS1 TO DOUBLE PRECISION WORD EQ2Y12, YPOS1 /ADDRESS OF WORD TO BE CONVERTED EQ2MD1, EQ1XH /ADDRESS OF WHERE TO STORE WORD CNVDBL /CONVERT ASSUMED Y TO DOUBLE PRECISION EQY1 /ADDRESS OF WORD TO BE CONVERTED ACHW /WHERE TO STORE IT - SETUP FOR SUBTRACTION DBLSUB /NEW DELTAY = (ASSUMED Y - YPOS1) EQ2MD2, EQ1XH /ADDRESS OF WORD TO BE SUBTRACTED EQ2MD3, EQ1XH /WHERE TO STORE RESULTS OF SUBTRACTION DBLMTY /DELTAX * NEW DELTAY SLPDXH /ADDRESS OF 2 WORD MULTIPLICAND EQ2MD4, EQ1XH /ADDRESS OF 2 WORD MULTIPLIER DBLDIV /(DELTAX*NEW DELTAY)/DELTAY SLPDYH /ADDRESS OF DOUBLE WORD DIVISOR CNVDBL /CONVERT XPOS1 TO DOUBLE PRECISION WORD EQ2X12, XPOS1 /ADDRESS OF WORD TO BE CONVERTED ACHW /WHERE TO STORE WORDS - SETUP FOR ADDITION DBLADD /X=X1+(DELTAX*NEW DELTAY)/DELTAY MQHW /ADDRESS OF RESULT FROM DIVISION EQ2MD5, EQ1XH /ADDRESS OF WHERE RESULT IS TO BE STORED TAD I EQ2MD5 /GET THE HIGH WORD OF CALCULATED X SZA CLA /SKIP IF NUMBER < 4096 AND NOT NEGATIVE JMP EQ2RET /NUMBER TO BIG OR NEGATIVE TAD I EQ2MD6 /GET THE LOW WORD OF CALCULATED X SPA CLA /SKIP IF <= 2047 JMP EQ2RET /NUMBER TO BIG MINMAX /GO VALIDATE THE X CO-ORDINATE CALCULATED EQ2MD6, EQ1XL EQ2MD7, EQ2FLG MINX MAXX EQ2RET, CLA CLL /NEEDED TO CLEANUP AC ON EXIT JMP I EQ2 /EXIT TO CALL+2 FOR VALID POINTS +3 FOR INVALID / EQX1, 0 /NEW X TO REPLACE X1 EQY1, 0 /NEW Y TO REPLACE Y1 / EQ1TBL, EQ1MD1 EQ1MD2 EQ1MD3 EQ1MD4 EQ1MD5 / EQ2TBL, EQ2MD1 EQ2MD2 EQ2MD3 EQ2MD4 EQ2MD5 PAGE /---------------------------------------------------------------------------- / CALXYS - CALCULATE NEW X AND Y CO-ORDINATES OF SCREEN BOUNDRIES /----------------------------------------------------------------------------- / CALXYS, 0 TAD OLDX DCA EQ1ORX TAD OLDY DCA EQ1ORY TAD OLDX DCA EQ2ORX TAD OLDY DCA EQ2ORY TAD SHDFLG SNA CLA JMP CHKSL0 TAD NEWX DCA EQ1ORX TAD NEWX DCA EQ2ORX TAD NEWY DCA EQ1ORY TAD NEWY DCA EQ2ORY CHKSL0, TAD XFLAG1 /CHECK IF POINTS X1,Y1 ARE ON SCREEN TAD YFLAG1 / SNA CLA JMP CHKSL1 /VALID SCREEN CO-ORDINATES - GO CHECK X2,Y2 JMS I RTEQ1 /SOLVE EQUATION FOR Y EQ1ORX, UNMODX /ORIGINAL STARTING X POSITION EQ1ORY, UNMODY /ORIGINAL STARTING Y POSITION EQ1ASX, 0 /ASSUMED X VALUE ON SCREEN EQ1YH, 0 /HIGH WORD - CALCULATED Y EQ1YL, 0 /LOW WORD - CALCULATED Y EQ1FLG, 0 /EQUATION 1 FALG WORD (-2 TO 2) TAD EQ1FLG /GET FLAG FROM Y CALCULATION SZA CLA /SKIP IF CO-ORDINATES ON THE SCREEN JMP CALXY1 /NOT ON SCREEN - TRY CALCULATING FOR X TAD EQ1ASX /GET THE ASSUMED X DCA XPOS1 /SAVE AS NEW XPOS1 ? TAD EQ1YL /GET THE CALCULATED Y DCA YPOS1 /SAVE AS NEW YPOS1 ? JMP CHKSL1 /GO CHECK X2 AND Y2 CO-ORDINATES CALXY1, JMS I RTEQ2 /SOLVE EQUATION FOR X EQ2ORX, UNMODX /ORIGINAL STARTING X POSITION EQ2ORY, UNMODY /ORIGINAL STARTING Y POSITION EQ2ASY, 0 /ASSUMED Y VALUE ON THE SCREEN EQ1XH, 0 /HIGH WORD - CALCULATED X EQ1XL, 0 /LOW WORD - CALCULATED X EQ2FLG, 0 /EQUATION 2 FLAG WORD (-2 TO 2) TAD EQ2FLG /GET FLAG FROM X CALCULATION SZA CLA /SKIP IF CO-ORDINATES ON THE SCREEN JMP CALXY2 /POINTS X1,Y1 NOT ON SCREEN SET LINE=INVISIBLE TAD EQ1XL /GET THE CALCULATED X DCA XPOS1 /SAVE AS NEW XPOS1 ? TAD EQ2ASY /GET THE ASSUMED Y DCA YPOS1 /SAVE AS NEW Y ? SKP CLA /GO CHECK CO-ORDINATES X2,Y2 CALXY2, ISZ I ELNINV /INVISIBLE LINE - SET FLAG TO INDICATE THIS / CHKSL1, TAD XFLAG2 /CHECK IF POINTS X2,Y2 ARE ON SCREEN TAD YFLAG2 / SNA CLA JMP CALXYE /THESE POINTS ARE ON SCREEN - EXIT AND DRAW LINE JMS I RTEQ1 /SOLVE EQUATION FOR Y RTSLX2 /ORIGINAL ENDING X POSITION RTSLY2 /ORIGINAL ENDING Y POSITION EQ3ASX, 0 /ASSUMED X VALUE ON THE SCREEN 0 /HIGH WORD - CALCULATED Y EQ3YL, 0 /LOW WORD - CALCULATED Y EQ3FLG, 0 /EQUATION 3 FALG WORD (-2 TO 2) TAD EQ3FLG /GET FLAG FROM Y CALCULATION SZA CLA /SKIP IF POINTS ARE VALID JMP CALXY3 /INVALID POINTS - GO CALCULTE FOR X TAD EQ3ASX /GET THE ASSUMED X DCA XPOS2 /SAVE AS POSSIBLE XPOS2 ? TAD EQ3YL /GET THE CALCULATED Y DCA YPOS2 /SAVE AS POSSIBLE YPOS2 ? JMP CALXYE /EXIT - X2,Y2 CLIPPED TO THE SCREEN CALXY3, JMS I RTEQ2 /SOLVE EQUATION FOR X RTSLX2 /ORIGINAL ENDING X POSITION RTSLY2 /ORIGINAL ENDING Y POSITION EQ4ASY, 0 /ASSUMED Y VALUE ON THE SCREEN 0 /HIGH WORD - CALCULATED X EQ4XL, 0 /LOW WORD - CALCULATED X EQ4FLG, 0 /EQUATION 4 FLAG WORD (-2 TO 2) TAD EQ4FLG /GET FLAG FROM X CALCULATION SZA CLA /SKIP IF CO-ORDINATES ON THE SCREEN JMP CALXY4 /X2,Y2 NOT ON SCREEN SET LINE=INVISIBLE TAD EQ4XL /GET THE CALCULATED X DCA XPOS2 /SAVE AS XPOS2 ? TAD EQ4ASY /GET THE ASSUMED Y DCA YPOS2 /SAVE AS YPOS2 ? SKP CLA CALXY4, ISZ I ELNINV /UPDATE FALG INDICATING LINE IS INVISIBLE CALXYE, JMP I CALXYS /EXIT BACK TO CALLER / ELNINV, INVISB /ADDRESS OF FLAG INDICATING LINE INVISIBLE RTEQ1, EQ1 RTEQ2, EQ2 OLDX, UNMODX OLDY, UNMODY NEWX, XPOS1 NEWY, YPOS1 / -------------------------------------------- / SAVEDX - SAVE A PARAMETER ON THE FIGS STRING / -------------------------------------------- / SAVEDX, 0 DCA SAVETM /SAVE THE PARAMETER TAD SAVETM /PUT LOW EIGHT BITS ON STRING AND K0377 DCA I AUTO10 TAD SAVETM /PUT HIGH FOUR BITS ON STRING (EXTEND SIGN) BSW RTR AND K0017 DCA SAVETM TAD K0010 AND SAVETM SZA CLA TAD K0060 TAD SAVETM DCA I AUTO10 JMP I SAVEDX / SAVETM, 0 K0060, 0060 / / / / / ---------------------------------- / FULARC - DRAW A SEGMENT OF A CURVE / ---------------------------------- / FULARC, 0 DCA ARCARY /SAVE THE BASE ADDRESS OF THE 4 POINTS TAD K0012 /INITIALIZE DRAW CURVE COUNT DCA REMAIN /SAVE IT TAD K11CRV /INITIALIZE NUMBER OF SEGMENTS TO DRAW DCA SEG /SAVE THE SEGMENT COUNTER JMS I CRVDRW /GO INTERPOLATE AND DRAW CURVE ARCARY, 0 /BASE ADDRESS OF 4 POINTS TO INTERPOLATE JMP I FULARC /ARC HAS BEEN DRAWN EXIT / / K11CRV, 11 CRVDRW, XCURVE PAGE / -------------------------------- / DRAW - DRAW THE SPECIFIED FIGURE / -------------------------------- / / CALLING FORMAT: DRAWIT / / / / DRAW, 0 CLA CLL TAD I DRAW /GET ADDRESS OF CURS STRING DCA DRAW7 / FOR ISSUING LATER ISZ DRAW /INCREMENT TO NEXT ARGUMENT / TAD I DRAW /GET ADDRESS OF FIGS/FIGD STRING DCA DRAW9 / FOR ISSUING LATER ISZ DRAW /INCREMENT TO NEXT ARGUMENT / TAD I DRAW /GET ADDRESS OF PRAM STRING DCA DRAWT5 / FOR ISSUING LATER ISZ DRAW /UPDATE POINTER FOR RETURN / JMS I XCOPPR /COPY PRAMS TO LOCAL STRING / TAD WRMODE /CHECK IF REPLACE MODE TO COUNT PASSES CIA / (MUST DO TWO PASSES IF REPLACE) DCA DRWCNT /SAVE AS LOOP CONTROL (NOT A COUNTER) / TAD COLORM /GET THE PLANE SELECT MASK WORD DCA DRAWT4 /SAVE THE PLANE SELECT MASK WORD NOTCOM, TAD BCOLOR /GET THE BACKGROUND COLOR DCA DRAWTM /SAVE IT AS THE POTENTIAL WRITING COLOR TAD OPCODE /GET THE OPERATION CODE BEING EXECUTED TAD OPCDSE /CHECK IT AGAINST SCREEN ERASE OPCODE SNA CLA /SKIP IF COMMAND NOT SCREEN ERASE JMP DRAWSE /SCREEN ERASE - ERASE TO BACKGROUND COLOR CLA CLL CMA RTL /-3 TAD WRMODE /GET THE WRITING MODE SNA CLA /IS WRITING MODE = ERASE JMP WMERAS /YES - GO LOAD PRAMS WITH ALL ONES TAD SHDFLG /GET THE SHADE FLAG SZA CLA /SKIP IF SHADING NOT TURNED ON JMS I SHDPAT /SHADING ON - SETUP SHADE PATTERN TAD FCOLOR /CHANGE WRITING COLOR TO FOREGROUND COLOR DCA DRAWTM /SAVE THE WRITING COLOR JMP DRAW1 /GO CHECK IF NEGATE MODE WMERAS, JMS I DRWONE /LOAD ALL PRAMS WITH 377 TAD NEGFLG /GET THE NEGATIVE WRITING MODE FLAG SNA CLA /SKIP IF SET JMP DRAWSE /NOT SET - GO DO ERASE WITH BACKGROUND COLOR TAD FCOLOR /GET THE FOREGROUND COLOR DCA DRAWTM /SAVE IT JMP DRAWSE /NEGATE ON - GO DO ERASE IN FOREGROUND COLOR DRAW1, TAD NEGFLG /GET THE NEGATIVE WRITING MODE FLAG SZA CLA /SKIP IF NOT SET DRAW1A, JMS I DRWCOM /GO COMPLEMENT THE WRITING PATTERN DRAWSE, SENDIT /SEND PRAMS STRING TO GDC DRWPRM / TAD M0004 /SET UP FOR FOUR PLANES DCA DRAWT1 DCA DRAW8 /SET UP FOR GREEN PLANE (00) FIRST AC0002 /GET ADDRESS OF COLOR PARAMETER IN CURS STRING TAD DRAW7 DCA DRAWT2 TAD I DRAWT2 /GET COLOR PARAMETER DCA DRAWT3 /SAVE IT TAD DRAWT3 /GET IT AGAIN AND K0077 /MASK TO GREEN PLANE DCA I DRAWT2 /AND PUT IT BACK / DRAW2, TAD DRAWT4 /GET THE PLANE SELECT MASK WORD CLL RAR /PUT PLANE SELECT BIT INTO LINK DCA DRAWT4 /SAVE THE UPDATED MASK WORD FOR NEXT PLANE SNL /SKIP IF PLANE IS TO BE MODIFIED JMP DRAW10 /PLANE PROTECTED - CAN NOT MODIFY IT CLA CLL CMA RAL /-2 TAD WRMODE /GET THE PRESENT WRITING MODE SZA CLA /SKIP IF WRITING MODE = COMPLEMENT JMP DRAW3 /NOT COMPLEMENT - CONTINUE SENDIT /COMPLEMENT, SET UP TO COMPLEMNT SPECIFIED PLANES SCOMP / JMP DRAW6 /GO WRITE THE PLANE IN COMPLEMENT MODE DRAW3, TAD DRAWTM /ROTATE COLOR PLANE INTO LINK CLL RAR SZL CLA /CHECK IF WRITE OR ERASE FOR THIS PLANE JMP DRAW4 SENDIT /ERASE, SET UP TO RESET THE SPECIFIED PLANE SCLEAR JMP DRAW6 DRAW4, SENDIT /WRITE, SET UP TO SET THE SPECIFIED PLANE SSET / DRAW6, SENDIT /SEND CURSOR SPECIFY COMMAND TO GDC DRAW7, 0 /(BECOMES ADDRESS OF CURS STRING) / LDREG1 /SELECT THE WRITE PLANES DRAW8, 0 /(BECOMES A PLANE SELECT) / SENDIT /SEND THE FIGS, FIGD STRING DRAW9, 0 /(BECOMES ADDRESS OF COMMAND STRING) / DRAW10, TAD DRAWTM /ROTATE COLOR MAP THROUGH LINK CLL RAR DCA DRAWTM TAD DRAW8 /SPECIFY THE NEXT PLANE FOR REG 1 WRITING TAD K0025 DCA DRAW8 AC100 /SPECIFY THE NEXT PLANE IN CURS STRING TAD I DRAWT2 DCA I DRAWT2 ISZ DRAWT1 /WRITTEN ALL PLANES JMP DRAW2 /NO DO NEXT PLANE / TAD DRAWT3 /RESTORE ORIGINAL VALUE DCA I DRAWT2 / / ISZ DRWCNT /CHECK IF REPLACE MODE FIRST PASS JMP DRWEXT /NOT REPLACE - GO RESTORE PRAM'S / /REPLACE MODE - DO ANOTHER PASS TAD BCOLOR /GET THE BACKGROUND COLOR DCA DRAWTM /SAVE IT TAD COLORM /GET THE COLOR PLANE MASK WORD DCA DRAWT4 /SAVE IT JMP DRAW1A /REPLACE MODE - GO WRITE PLANES IN BACKGROUND / DRWEXT, JMP I DRAW /RETURN / OPCDSE, -SE /OPERATION CODE FOR SCREEN ERASE (NEGATIVE) XCOPPR, COPPRM /ROUTINE TO COPY PRAM STRING DRWONE, LODPRM /ROUTINE TO LOAD PRAM'S WITH ONES DRWCOM, COMPRM /ROUTINE TO COMPLEMENT PRAM'S SHDPAT, LDATXT /ROUTINE TO LOAD THE SHADE PATTERN DRAWTM, 0 /COLOR TO BE USED IN GRAPHIC WRITING DRAWT1, 0 /USED AS PLANE WRITTEN COUNTER DRAWT2, 0 /ADDRESS OF CURSOR COLOR PLANE SELECT PARAMETER DRAWT3, 0 /USED AS TEMP FOR COLOR PLANE SELECT PARAMETER DRAWT4, 0 /USED AS TEMP FOR COLOR PLANE MASK WORD DRAWT5, 0 /USED AS POINTER TO CALLERS PRAM STRING K0025, 25 /USED TO SELECT REG 1 COLOR PLANES DRWCNT, 0 /LOOP CONTROL FLAG /------------------------------------------------------------------------------- / GTWRTM - GET WRITING MODE - 0=OVERLAY 1=REPLACE 2=COMPLEMENT 3=ERASE /------------------------------------------------------------------------------ / GTWRTM, 0 GETPRM /GET PARAMETER FROM CALLING FIELD CLL /CLEAR THE LINK TAD M0004 /IF NUMBER NEGATIVE OR > 3 THEN ILLEGAL SZL /SKIP IF VALID WRITING MODE JMP GTWEXT /INVALID WRITING MODE SELECTED - EXIT TAD K4WM /RESTORE THE ORIGINAL NUMBER DCA WRMODE /SAVE AS THE NEW WRITIMG MODE GTWEXT, CLA CLL /NEEDED FOR ILLEGAL PARAMETER JMP I GTWRTM /EXIT BACK TO CALLER / K4WM, 4 PAGE /----------------------------------------------------------------------------- / XMNMAX - CHECK CO-ORDINATE TO BE TO THE LEFT, RIGHT ABOVE, BELOW OR ON / THE SCREEN. / / / MINMAX CALL MINIMUM/MAXIMUM CHECK ROUTINE / XY ADDRESS OF WORD TO BE CHECKED / FLAG ADDRESS OF X OR Y FLAG / MIN ADDRESS OF LOCATION CONTAINING MINIMUM VALUE ALLOWED / MAX ADDRESS OF LOCATION CONTAINING MAXIMUM VALUE ALLOWED+1 / / FLAG / -2 IF CO-ORDINATE IS LESS THEN MINIMUM / -1 IF CO-ORDINATE IS GREATER THEN OR EQUAL MAXIMUM+1 / 0 IF CO-ORDINATE IS ON THE SCREEN /----------------------------------------------------------------------------- / XMNMAX, 0 CLA CLL TAD I XMNMAX /GET ADDRESS OF VALUE FOR COMPARISONS DCA MVALUE /SAVE THE ADDRESS ISZ XMNMAX /UPDATE PARAMETER POINTER TAD I XMNMAX /GET ADDRESS OF FLAG DCA MFLAG /SAVE THE ADDRESS OF THE FLAG CLA CLL CMA RAL /INITIALIZE THE FLAG TO BE LESS THEN MINIMUM DCA I MFLAG /SAVE THE FLAG AS BEING LESS THEN MIN ISZ XMNMAX /UPDATE THE PARAMETER POINTER TAD I XMNMAX /GET THE ADDRESS OF THE MINIMUM DCA MLIMIT /SAVE THE ADDRESS ISZ XMNMAX /UPDATE THE PARAMTER POINTER TAD I MVALUE /CHECK IF THE SIGN IS NEGATIVE SPA CLA /IF NOT - THEN CHECK IF BEFORE DISPLAY REGION JMP MEXIT /POINT DEFINITELY BEFORE THE SCREEN - EXIT TAD I MLIMIT /GET THE LOWER LIMIT CIA /NEGATE IT TAD I MVALUE /GET THE CO-ORDINATE VLAUE SPA CLA /SKIP IF GREATER THEN MINIMUM JMP MEXIT /EXIT VALUE LESS THEN MIN - FLAG = -2 ISZ I MFLAG /UPDATE THE FLAG TO BE GREATER THEN MAX TAD I XMNMAX /GET THE ADDRESS OF THE MAXIMUM ALLOWED DCA MLIMIT /SAVE THE ADDRESS TAD I MLIMIT /GET THE MAXIMUM ALLOWED VALUE +1 CIA /NEGATE IT TAD I MVALUE /GET THE CO-ORDINATE VLAUE SPA CLA /SKIP IF VALUE >= MAXIMUM +1 DCA I MFLAG /THIS CO-ORDINATE IS VALID FLAG = 0 MEXIT, ISZ XMNMAX /UPDATE THE RETURN POINTER JMP I XMNMAX /EXIT BACK TO CALLER / MVALUE, 0 /POINTER TO CO-ORDINATE MFLAG, 0 /POINTER TO CO-ORDINATES FLAG MLIMIT, 0 /POINTER TO MIN OR MAX COMPARISON VALUES / --------------------------------------------- / COPPRM - COPY PRAM STRING FROM USER TO 'DRAW' / --------------------------------------------- / COPPRM, 0 / ACNEG1 /GET POINTER (-1) TO USER STRING TAD I XDRWT5 DCA AUTO10 / ACNEG1 /GET POINTER (-1) TO DRAW'S STRING TAD XDRWPR DCA AUTO11 / COPPR2, TAD I AUTO10 /GET A WORD SPA /CHECK FOR TERMINATOR (7777) JMP COPPR4 /IS TERMINATOR, GO FINISH DCA I AUTO11 /NOT YET DONE, SAVE THE WORD JMP COPPR2 / AND TRY ANOTHER / COPPR4, DCA I AUTO11 /SAVE THE TERMINATOR, TOO / JMP I COPPRM /RETURN / / XDRWT5, DRAWT5 / / / ------------------ / COPDAT - MOVE DATA / ------------------ / COPDAT, 0 DCA COPCNT /SAVE THE NUMBER OF WORDS TO COPY TAD I COPDAT /GET ADDRESS OF DATA TO BE MOVED DCA AUTO10 /SAVE ADDRESS -1 ISZ COPDAT TAD I COPDAT /GET ADDRESS OF WHERE TO STORE DATA DCA AUTO11 /SAVE ADDRESS -1 ISZ COPDAT /UPDATE THE RETURN POINTER COPLOP, TAD I AUTO10 /GET THE WORD TO BE MOVED DCA I AUTO11 /MOVE THE WORD ISZ COPCNT /DONE ? JMP COPLOP /NO - MOVE NEXT WORD JMP I COPDAT /EXIT / COPCNT, 0 /------------------------------------------------------------------------------- / LODPRM - LOAD PRAM STRING WITH 0377'S /------------------------------------------------------------------------------ / LODPRM, 0 / TAD XDRWPR /GET ADDRESS OF PRAM STRING DCA AUTO10 TAD XDRWPR /GET IT AGAIN DCA AUTO11 / LODPR2, TAD I AUTO10 /GET A PARAMETER FROM STRING SPA /CHECK IF TERMINATOR (7777) JMP LODPR4 /FINISH UP, IF SO / CLA CLL TAD K0377 /NOT YET AT TERMINATOR, GET A 0377 DCA I AUTO11 /PUT IT INTO PRAM STRING / JMP LODPR2 /REPEAT UNTIL STRING TERMINATED / LODPR4, DCA I AUTO11 /PACK AWAY THE TERMINATOR JMP I LODPRM /RETURN / / XDRWPR, DRWPRM /POINTER TO ADDRESS OF PRAM STRING / / /------------------------------------------------------------------------------- / COMPRM - COMPLEMENT PRAM STRING /------------------------------------------------------------------------------- / COMPRM, 0 / TAD XDRWPR /GET ADDRESS OF PRAM STRING DCA AUTO10 TAD XDRWPR /GET ADDRESS AGAIN DCA AUTO11 / COMPR2, TAD I AUTO10 /GET A PARAMETER FROM THE STRING SPA /CHECK IF TERMINATOR JMP COMPR4 /IF SO, FINISH UP / CMA /NOT YET TERMINATOR, COMPLEMENT ARGUMENT AND K0377 /MASK TO EIGHT BITS DCA I AUTO11 /PUT BACK INTO STRING JMP COMPR2 /REPEAT UNTIL TERMINATOR / COMPR4, DCA I AUTO11 /PACK AWAY TERMINATOR JMP I COMPRM /RETURN / / AREPAT, 570; 377; 377; 377; 377; 377; 377; 377; 377 /PRAM (GETS MODIFIED) 7777 SAREA, 514 SAREP1, 22; 0; 0; 0; 0; 0; 0 /FIGS 550 /GCHRD 7777 /TERMINATOR / / DRWPRM, ZBLOCK 0012 /STORAGE FOR 'DRAW'S PRAM STRING /(THIS IS BIG ENOUGH FOR LONGEST PRAM STRING) / / POSITION CURSOR / SPOSIT, 511; 0; 0; 0 /MODIFIED IN CODE 7777 PAGE /------------------------------------------------------------------------------ / XSGNCK - ADD TWO NUMBERS - IF LIKE SIGNS AND OPPOSITE SIGN ON RESULT - INVALID / ON EXIT AC= RESULT OF ADDITION OR DEFAULT VALUES IF OVERFLOW /------------------------------------------------------------------------------- / XSGNCK, 0 DCA NUM1 /SAVE THE FIRST NUMBER TO ADD CLA CLL CMA RAL /-2 DCA SGNFLG /SET THE SIGN FLAG TAD I XSGNCK /GET THE ADDRESS OF THE SECOND NUMBER TO ADD DCA ADDNUM /SAVE THE ADDRESS ISZ XSGNCK /UPDATE POINTER FOR RETURN TAD I ADDNUM /GET THE SECOND NUMBER SMA /CHECK IF SIGN IS MINUS JMP POSCHK /NO - SIGN IS POSITIVE DCA ADDNUM /SAVE THE SECOND NUMBER TAD NUM1 /GET THE FIRST NUMBER SPA /IS IT POSITIVE ? ISZ SGNFLG /NO - THEN TWO NEGATVE NUMBERS BEING ADDED TAD ADDNUM /ADD THE SECOND NUMBER TO THE FIRST SPA /POSITVE RESULT JMP ADDOK /RESULT NEGATIVE - NO FURTHER CHECKING NEEDED JMP CKLSGN /GO CHECK IF TWO NUMBERS HAD LIKE SIGNS POSCHK, DCA ADDNUM /SAVE THE SECOND NUMBER TAD NUM1 /GET THE FIRST NUMBER SMA /IS IT NEGATIVE ? ISZ SGNFLG /NO - THEN TWO POSITIVE NUMBERS BEING ADDED TAD ADDNUM /ADD SECOND NUMBER TO FIRST SMA /NEGATIVE RESULT JMP ADDOK /POSITVE RESULT - NO FURTHER CHECKING NEEDED CKLSGN, CLL CML /SET LINK IN CASE NUMBERS CAUSED OVERFLOW ISZ SGNFLG /SKIP IF THERE WAS AN OVERFLOW ADDOK, CLL /NO - NUMBERS ADDED ARE OK SNL /SKIP IF AN OVERFLOW ERROR EXISTS JMP I XSGNCK /LINK=0 FOR VALID ADD - LINK=1 ON OVERFLOW CLA TAD ADDNUM /GET ONE OF THE NUMBERS SPA CLA /CHECK ITS SIGN IAC /DEFAULT VALUE TO -2048 TAD C3777 /DEFAULT VALUE TO +2047 JMP I XSGNCK /EXIT BACK WITH DEFAULT VALUE IN AC / NUM1, 0 ADDNUM, 0 SGNFLG, 0 C3777, 3777 / ---------------------------------------------------------- / SENDAL - SEND COMMANDS AND DATA TO THE GRAPHICS CONTROLLER / ---------------------------------------------------------- / / COMMANDS AND DATA ARE IN A STRING WHOSE ADDRESS FOLLOWS CALL / A 7777 TERMINATES THE STRING / SENDAL, 0 / CLA CLL /GET STRING ADDRESS TAD I SENDAL TAD M0001 /BACK UP STRING POINTER DCA AUTO10 / ISZ SENDAL /INCREMENT TO CORRECT RETURN ADDRESS / SENDA2, TAD I AUTO10 /GET A VALUE IAC /CHECK FOR TERMINATOR SNA JMP I SENDAL /RETURN IF TERMINATOR / TAD M0001 /RESTORE VALUE AND K0777 /MASK TO NINE BITS DCA STEMP / SENDA4, GRGR /READ STATUS RTR /ROTATE 'FIFO FULL' TO LINK SZL CLA JMP SENDA4 /LOOP ON STATUS CHECK UNTIL ROOM IN FIFO / TAD STEMP /GET THE VALUE BACK GRGW /SEND TO GDC CLA JMP SENDA2 /LOOP THROUGH VALUES TO SEND / STEMP, 0 K0777, 0777 / ---------------------------------------- / SLINE - GDC FIGS STRING FOR LINE DRAWING / ---------------------------------------- / SLINE, 514; 10; 0; 0; 0; 0; 0; 0; 0; 0 /FIGS (MODIFIED IN CODE) 554 /FIGD 7777 /TERMINATOR /---------------------------------------------------------------------------- / XCURSR - TURN THE GRAPHIC CURSOR ON OR OFF /----------------------------------------------------------------------------- / XCURSR, 0 TAD PWRUPF /GET THE POWER UP FLAG CIA /NEGATE IT TAD OPCODE /CHECK IT AGAINST PRESENT OPCODE SNA CLA /SKIP IF NOT POWER UP JMP I XCURSR /EXIT TAD CURFLG /GET THE CURSOR FLAG SPA CLA /SKIP IF NOT TURNED ON JMP OFFON /CURSOR ON - UNCONDITIONALLY CLEAR IT CLA CLL IAC /SETUP TO CHECK IF CURSOR ENABLED AND CURFLG /MASK TO CURSOR ENABLE/DISABLE BIT SZA CLA /SKIP IF ENABLED JMP I XCURSR /EXIT - CURSOR DISABLED OFFON, CHKXY1 /CHECK STARTING POINTS - FLAGS RETURNED SZA CLA /SKIP IF BOTH POINTS ON SCREEN JMP I XCURSR /EXIT - CURSOR OFF THE SCREEN TAD CURFLG /GET THE CURSOR FLAG AGAIN CLL RAL /PUT OFF ON BIT INTO LINK CML /COMPLEMENT IT RAR /RESTORE WORD WITH OFF/ON COMPLEMENTED DCA CURFLG /SAVE THE UPDATED CURSOR FLAG / CIF TBLFLD /AUXILIARY FIELD FOR ROUTINE JMS I XSAVMO /SAVE WRITING MODES / AC0002 /FORCE WRITING MODE TO 'COMPLEMENT' DCA WRMODE DCA NEGFLG /FORCE NEGATE MODE OFF DCA SHDFLG /FORCE SHADE MODE OFF / AC0010 /SET UP INITIAL DIRECTION FOR FIRST 'HAIR' DCA I XCRSRD / BLDPOS /BUILD THE CURSOR POSITION CURCUR /ADDRESS OF GRAPHIC CURSOR STRING / TAD M0004 /DO FOUR 'HAIRS' DCA XCURTM / XCURS4, DRAWIT /TURN THE CURSOR ON/OFF CURCUR CURFIG CURPRA / AC0002 /ROTATE 'HAIR' 90 DEGREES TAD I XCRSRD DCA I XCRSRD / BY CHANGING FIGS DIRECTION / ISZ XCURTM /INCREMENT THROUGH ALL FOUR 'HAIRS' JMP XCURS4 / CIF TBLFLD /AUXILIARY FIELD FOR ROUTINE JMS I XRESMO /RESTORE ORIGINAL WRITING MODES / JMP I XCURSR /EXIT / PWRUPF, PWR /POWER UP OPERATION CODE M0700, -0700 M40, -0040 K20, 0020 XCURTM, 0 XCRSRD, CURFIG+1 XSAVMO, SAVMOD XRESMO, RESMOD PAGE / --------------------------------------------------------------------------- / XERASE - ERASE THE GRAPHICS SCREEN / --------------------------------------------------------------------------- / XERASE, 0 SENDIT /CURSOR TO HOME SHOME LDREG1 /SELECT PLANES 1, 2, AND 3 71 SENDIT /ERASE THE SCREEN SERASE JMP I XERASE /RETURN /------------------------------------------------------------------------------- / DOPOS - BUILD A COMMAND TO POSITION THE CURSOR / ----------------------------------------------------------------------------- / DOPOS, 0 CLA CLL TAD YPOS1 /GET THE LOGICAL Y CO-ORDINATE POSITION CLL RAR /DIVIDE IT BY 2 DCA PYPOS1 /SAVE FOR FURTHER USE AS PHYSICAL Y CO-ORDINATE TAD I DOPOS /GET ADDRESS OF 'CURS' COMMAND STRING DCA AUTO10 / INTO AUTOINCREMENTING REGISTER ISZ DOPOS /INCREMENT TO CORRECT RETURN ADDRESS TAD XPOS1 /BUILD 'P1' ARGUMENT FROM X AND Y POSITIONS RTR RTR AND K0077 DCA DOTEMP TAD PYPOS1 BSW AND K0300 TAD DOTEMP DCA I AUTO10 TAD PYPOS1 /BUILD 'P2' ARGUMENT FROM Y POSITION RTR AND K0077 DCA I AUTO10 TAD XPOS1 /BUILD 'P3' ARGUMENT FROM X POSITION RTL RTL AND K0360 DCA I AUTO10 JMP I DOPOS /RETURN / DOTEMP, 0 K0300, 300 K0360, 360 /------------------------------------------------------------------------------- / GTLMLT - GET LINE MULTIPLIER - 0 OR 1 =1 2 OR GREATER IMPLIES 2 /------------------------------------------------------------------------------- / GTLMLT, 0 GETPRM /GET LINE PATTERN MULTIPLIER FROM CALLING FIELD SNA SPA /SKIP IF NUMBER GREATER THEN 0 CLA IAC /WAS 0 OR LESS - DEFAULT TO 1 DCA PATMLT /SAVE THE PATTERN MULTIPLIER JMS I XXUPDP /GO UPDATE THE LINE DRAWING PATTERN JMP I GTLMLT /EXIT BACK TO CALLER / / XXUPDP, UPDPAT /----------------------------------------------------------------------------- / SCRDMP - RDAT READ FOR SCREEN DUMP /------------------------------------------------------------------------------ / / CONTROL BLOCK: / 0024 /COMMAND 20. - READ PIXELS FROM SCREEN / X-POSITION / Y-POSITION / 48.-WORD BLOCK FOR RETURN DATA / BACKGROUND COLOR OF LAST SCREEN ERASE SCRDMP, 0 JMS I XSVCUR /SAVE PRESENT CURSOR POSITION GETXY1 /GET X AND Y POSITIONS FROM CALLER BLDPOS /CREATE 'POSITION CURSOR' STRING SCRDS2 TAD M0004 /SET UP FOR FOUR PLANES DCA SCRDT3 DCA SCRDM2 /ENSURE STARTING WITH GREEN PLANE SCRDM1, LDREG1 /ENSURE READING FROM CORRECT PLANE SCRDM2, 00 /(MODIFIED IN CODE) TAD M14 DCA SCRDT1 /SET UP FOR COUNT OF 12. BYTES SENDIT /SET UP FOR DMA READ SCRDS2 SCRDM5, GRGR /READ GDC'S STATUS RAR /ROTATE DATA READY BIT TO LINK SNL CLA JMP SCRDM5 /LOOP UNTIL IT'S SET TAD KK0400 /FORCE A FIFO READ GRGR /READ BYTE FROM FIFO AND K0377 /MASK TO A BYTE PUTPRM /PUT IN CALLER'S CONTROL BLOCK ISZ SCRDT1 /INCREMENT COUNTER JMP SCRDM5 /LOOP THROUGH READ OF THIS PLANE TAD KKK25 /UPDATE THE PLANE TAD SCRDM2 /BUMP REGISTER ONE TO NEXT PLANE DCA SCRDM2 AC100 /BUMP CURSOR POSITION TO CORRECT PLANE TAD SCRDS2+2 / DCA SCRDS2+2 ISZ SCRDT3 /INCREMENT THROUGH PLANE COUNTER JMP SCRDM1 TAD PRTBCL /GET THE LAST SCREEN ERASE BACKGROUND COLOR PUTPRM /PUT IT IN THE CALLER'S CONTROL BLOCK JMS I XRSCUR /RESTORE THE ORIGINAL CURSOR POSITION JMP I SCRDMP /RETURN / SCRDS2, 511; 0; 0; 0 /CURS TO HOME 512; 377; 377 /MASK 514; 0; 6; 0 /FIGS 640 /RDAT 7777 / XSVCUR, SAVCUR /SAVE THE PRESENT CURSOR POSITION XRSCUR, CURRST /RESTORE CURSOR PPOSITION SAVED SCRDT1, 0 SCRDT3, 0 KK0400, 0400 KKK25, 25 M14, -14 / CURCUR, 511; 0; 0; 0 /'CURSOR' CURSOR STRING 7777 / CURPRA, 570; 377; 377 /'CURSOR' PRAM - SOLID LINE 7777 / /'CURSOR' FIGS CURFIG, 514; 10; 10; 0; 370; 77; 360; 77; 0; 0 554 7777 / DUMMY, 570 /DUMMY COMMAND BEFORE LOADING REGISTER 1 7777 PAGE /------------------------------------------------------------------------------ / SVTMPW - SAVE WRITE OPTIONS /------------------------------------------------------------------------------ / SVTMPW, 0 TAD SVRSTF /GET THE WRITE OPTION'S SAVE/RESTORE FLAG SZA CLA /SKIP IF OPTIONS NOT SAVED PREVIOUSLY JMP I SVTMPW /EXIT - OPTIONS ALREADY SAVED ISZ SVRSTF /SET FLAG EQUAL SAVE TAD MWOSVT /GET NUMBER OF WORDS TO SAVE JMS I XCOPY /GO STORE THE WRITE OPTIONS FCOLOR-1 /ADDRESS -1 OF WORDS TO BE SAVED WOPTBF-1 /ADDRESS -1 OF WHERE TO STORE WRITE OPTIONS JMP I SVTMPW /EXIT - WRITE OPTIONS SAVED /------------------------------------------------------------------------------ / RSTMPW - RESTORE WRITE OPTIONS /------------------------------------------------------------------------------ / RSTMPW, 0 TAD SVRSTF /GET THE SAVE/RESTORE FLAG SNA CLA /SKIP IF WRITE OPTIONS SAVES PREVIOUSLY JMP I RSTMPW /EXIT DCA SVRSTF /SET SAVE-RESTORE FLAG=RESTORE TAD MWOSVT /GET NUMBER OF WORDS TO BE RESTORED JMS I XCOPY /GO RESTORE WRITE OPTIONS SAVED WOPTBF-1 /ADDRESS -1 OF WRITE OPTION BUFFER FCOLOR-1 /ADDRESS -1 OF WHERE TO RESTORE OPTIONS JMS I XUPDPT /GO REBUILD THE LINE PATTERN JMP I RSTMPW /EXIT - WRITE OPTIONS RESTORED / XCOPY, COPDAT XUPDPT, GTATXT MWOSVT, -TMPSIZ / CHRBMP, ZBLOCK 10 /AREA PATTERN FOR SHADING / SHOME, 511; 0; 0; 0 /MOVE CURSOR HOME 7777 /----------------------------------------------------------------------------- / PRIMRT - SUBROUTINES FOR GRAPHIC PRIMITIVES / DBLADD /DOUBLE PRECISION ADD - RESULT IN ACHW + ACLW / DBLSUB /DOUBLE PRECISION SUB - RESULT IN ACHW + ACLW / DBLMTY /DOUBLE PRECISION SIGN MULT - RESULT ACH-MQL / DBLDIV /DOUBLE PRECISION SIGN DIVIDE - RESULT MQH-MQL / CNVDBL /CONVERT SINGLE WORD TO DOUBLE PRECISION WORD / /----------------------------------------------------------------------------- /----------------------------------------------------------------------------- / RNDOFF - ROUND UP THE QUOTIENT FROM THE DOUBLE PRECISION SIGNED DIVIDE /----------------------------------------------------------------------------- / RNDOFF, 0 TAD SRH /GET THE HIGH WORD OF POSITIVE DIVISOR CLL RAR /DIVIDE IT BY 2 - LINK AS LSB OF DIVIDE DCA SRH /SAVE THE HIGH WORD OF DIVISOR TAD SRL /GET THE LOW WORD OF DIVISOR RAR /DIVIDE IT BY 2 ADDING IN LSB FROM HIGH WORD DCA SRL /SAVE THE LOW WORD OF DIVISOR DBLSUB /SUBRACT (DIVISION REMAINDER-DIVISOR/2) SRH /ADDRESS OF DIVISOR/2 SRH /WHERE TO STORE RESULT OF SUBTRACTION TAD SRH /GET HIGH WORD RESULT OF SUBTRACTION SMA SZA /SKIP IF DIVISOR/2 >= REMAINDER JMP RNDUP1 /DIVISOR/2 < REMAINDER - GO ROUND UP QUOTIENT SZA CLA /CHECK ID DIVISOR/2 <= REMAINDER JMP RNDEXT /EXIT - DIVISOR/2 > REMAINDER RNDUP1, ISZ MQLW /UPDATE LOW WORD OF QUOTIENT SKP CLA /SKIP IF NO OVERFLOW ISZ MQHW /UPDATE HIGH WORD OF QUOTIENT IF OVERFLOW NOP /SAFETY RNDEXT, CLA CLL /EXIT WITH AC AND LINK CLEARED JMP I RNDOFF /EXIT BACK TO DIVISION ROUTINE /----------------------------------------------------------------------------- / TADD - DOUBLE PRECISION ADDITION ROUTINE /----------------------------------------------------------------------------- / / SETUP LOCATIONS ACHW AND ACLW PRIOR TO ENTRANCE / DBLADD / ADDR1 /ADDRESS OF DATA TO BE ADDED / ADDR2 /ADDRESS OF WHERE TO STORE RESULTS OF ADD / TADD, 0 CLA CLL TAD I TADD /GET ADDRESS OF ADDEND JMS GET /MOVE ADDEND TO SR JMS ADDS /ADD SR TO AC ISZ TADD /UPDATE RETURN POINTER TAD I TADD /ADDRESS OF WHERE RESULT IS TO BE STORED JMS PUT /STORE THE DATA ISZ TADD /UPDATE POINTER FOR RETURN JMP I TADD /RETURN - RESULTS IN ACH AND ACL /------------------------------------------------------------------------------- / TSUB - SIGNED DOUBLE PRECISION SUBTRACTION ROUTINE /------------------------------------------------------------------------------- / / SETUP LOCATIONS ACHW AND ACLW WITH INITIAL DATA BEFORE SUBTRACTION / DBLSUB /CALL THE SUBTRACTION ROUTINE / ADDR1 /ADDRESS OF DATA TO BE SUBTRACTED (HIGH WORD) / ADDR2 /ADDRESS OF WHERE TO STORE RESULTS OF SUB / TSUB, 0 CLA CLL TAD I TSUB /GET ADDRESS OF SUBTRAHEND JMS GET /MOVE SUBTRAHEND TO SR JMS COMP /COMPLEMENT SR SRH /ADDRESS OF DATA TO BE COMPLEMENTED JMS ADDS /ADD SR TO AC ISZ TSUB /UPDATE RETURN POINTER TAD I TSUB /GET ADDRESS OF WHERE TO STORE RESULTS JMS PUT /GO STORE THE RESULTS ISZ TSUB /UPDATE THE RETURN POINTER JMP I TSUB /EXIT - RESULTS OF SUB IN ACH AND ACL / / ROUTINE TO GET HIGH AND LOW WORD OF DATA AND STORE IN SRH AND SRL / GET, 0 DCA ERAS /SAVE THE ADDRESS TAD I ERAS /GET HIGH WORD DCA SRH /SAVE ISZ ERAS /MOVE POINTER TO LOW WORD TAD I ERAS /GET TEH LOW WORD DCA SRL /SAVE JMP I GET /EXIT - SRH AND SRL LOADED / / ROUTINE TO STORE DATA INTO CALLING SPECIFIED ADDRESS / PUT, 0 DCA ERAS /SAVE THE ADDRESS OF WHERE TO STORE DATA TAD ACHW /GET THE HIGH ORDER RESULT DCA I ERAS /PUT IN CALLING ROUTINES SPECIFIED ADDRESS ISZ ERAS /UPDATE ADDRESS TO LOW WORD TAD ACLW /GET THE LOW ORDER RESULT DCA I ERAS /PUT IT IN CALLING ROUTINES SPECIFIED ADDRESS JMP I PUT /EXIT / / ROUTINE TO ADD THE TWO 24 BIT WORDS / ADDS, 0 CLA CLL TAD ACLW /GET LOW ORDER WORD TAD SRL /GET LOW ORDER OF ADDEND DCA ACLW /SAVE THE RESULT GLK /GET THE CARRY TAD ACHW /ADD IT TO HIGH ORDER WORD TAD SRH /ADD THAT TO HIGH ORDER ADDEND DCA ACHW /SAVE THE RESULT JMP I ADDS /EXIT / / ROUTINE TO COMPLEMENT THE 24 BIT WORD / COMP, 0 CLA CLL IAC /1 TAD I COMP /+HIGH ORDER ADDRESS DCA ERAS /SAVE AS LOW ORDER WORD ADDRESS TAD I ERAS /GET THE LOW ORDER WORD CIA /NEGATE IT DCA I ERAS /SAVE THE LOW ORDER PRODUCT GLK /GET THE CARRY BIT DCA ERAS /SAVE IT TAD I COMP /GET THE HIGH ORDER WORD ADDRESS DCA ERASX /SAVE THE ADDRESS TAD I ERASX /GET THE HIGH ORDER WORD CMA /1'S COMPLEMENT IT TAD ERAS /ADD CARRY TO IT DCA I ERASX /SAVE THE NEW HIGH ORDER WORD ISZ COMP /UPDATE POINTER FOR RETURN JMP I COMP /RETURN / ERASX, 0 ERAS, 0 PAGE / /----------------------------------------------------------------------------- / TMPY - DOUBLE PRECISION SIGNED MULTIPLY - RETURN WITH RESULTS IN ACHW-MQLW /----------------------------------------------------------------------------- / / DBLMTY /CALL DOUBLE PRECISION SIGNED MULTIPLY / ADDR1 /ADDRESS OF DOUBLE WORD MULTIPLICAND / ADDR2 /ADDRESS OF DOUBLE WORD MULTIPLIER / / RETURN WITH RESULTS IN ACWH-MQLW TMPY, 0 CLA CLL TAD I TMPY /GET ADDRESS OF HIGH WORD MULTIPLICAND DCA MERAS /SAVE IT TAD I MERAS /GET HIGH ORDER WORD MULTIPLICAND DCA MQHW /SAVE IT ISZ MERAS /POINT TO LOW WORD MULTIPLICAND TAD I MERAS /GET LOW ORDER WORD MULTIPLICAND DCA MQLW /SAVE IT ISZ TMPY /INDEX OVER ADDRESS DCA ACLW /CLEAR LOW WORD OF AC DCA ACHW /CLEAR HIGH WORD OF AC DCA MSIGN /SET SIGN OF RESULT SWITCH TAD I TMPY /GET ADDRESS OF MULTIPLIER DCA MERAS /SAVE IT TAD I MERAS /GET HIGH WORD OF MULTIPLIER DCA SRH /SAVE IT ISZ TMPY /UPDATE THE RETURN POINTER ISZ MERAS /POINT TO LOW WORD OF MULTIPLIER TAD I MERAS /GET LOW WORD OF MULTIPLIER DCA SRL /SAVE IT TAD MQHW /HIGH ORDER MULTIPLICAND SMA CLA /IS IT NEGATIVE JMP TMPY1 /NO ISZ MSIGN /YES - SET SIGN SWITCH JMS I XCOMP /GO COMPLEMENT THE MULTIPLICAND MQHW /ADDRESS OF DATA TO BE COMPLEMENTED TMPY1, TAD SRH /HIGH ORDER MULTIPLIER SMA CLA /IS IT NEGATIVE JMP TMPY2 /NO ISZ MSIGN /YES - SET SIGN SWITCH JMS I XCOMP /GO COMPLEMENT MULTIPLIER SRH TMPY2, TAD M30 /-24 DCA MSHCT /-24 TO SHIFT COUNTER / THIS IS THE MULTIPLICATION LOOP / MLP, CLA CLL TAD MQLW /LOW ORDER MQ RAR /OBTAIN RIGHTMOST BIT SNL /WAS IT A 1 JMP MSHFT /NO .... JUST SHIFT CLA CLL /YES ... ADD SR TO AC TAD ACLW /LOW ORDER ADD TAD SRL / DCA ACLW /SAVE TRE RESULT GLK /GET THE CARRY TAD ACHW /HIGH ORDER ADD TAD SRH / DCA ACHW /SAVE THE RESULT / / NOW SHIFT AC AND MQ RIGHT ONE PLACE / AS A 48 BIT REGISTER / MSHFT, CLA CLL DCA MERAS /ZERO SHIFT BIT LOC TAD AMSHCT /ADDRESS OF HIGH ORDER AC-1 DCA AUTO16 /SAVE TO AUTO INDEX REGISTER 6 TAD AMSHCT /ADDRESS OF HIGH ORDER AC-1 DCA AUTO17 /SAVE TO AUTO INDEX REGISTER 7 TAD M0004 /-4 DCA MERASX /SAVE WORD COUNT MSHFT1, TAD I AUTO16 /GET WORD RAR /SHIFT RIGHT 1 TAD MERAS /+ BIT SHIFTED OUT OF LAST WORD DCA I AUTO17 /SAVE TO SAME WORD RAR /CARRY TO HIGH ORDER AC DCA MERAS /TO BIT LOST LOCATION ISZ MERASX /INDEX ON # OF WORDS IN AC-MQ (4) JMP MSHFT1 /RETURN FOR NEXT WORD ISZ MSHCT /INDEX ON SHIFT COUNTER JMP MLP /RETURN FOR MORE / / OVER WITH MULTIPLICATION / NOW SET SIGN OF RESULT / CLA CLL TAD MSIGN /GET THE SIGN RAR /SHIFT RIGHT ONE SNL CLA /WAS IT AND ODD NO JMP I TMPY /NO...RETURN WITH POSITIVE NUMBER IN AC-MQ JMS C48 /YES..COMPLEMENT 48 BIT PRODUCT JMP I TMPY /RETURN WITH COMPLEMENTED PRODUCT IN AC-MQ / SUBROUTINE TO COMPLEMENT AC AND MQ / AS 1 48 BIT REGISTER / C48, 0 CLA CLL TAD M0004 /SETUP FOR 4 WORDS DCA MERAS /SAVE COUNTER TAD AMQLW /GET ADDRESS OF LOW WORD MQ DCA MERASX /SAVE IT TAD MQLW /GET LOW ORDER MQ CIA /NEGATE IT JMP C48B /ENTER LOOP IN MIDDLE / C48A, CLA CMA CLL CML / TAD MERASX /-1+ADDRESS OF CURRENT REGISTER DCA MERASX /NEW ADDRESS TAD I MERASX /CONTENTS OF CURRENT REGISTER CMA /1'S COMP IT TAD MSIGN /+OVERFLOW BIT C48B, DCA I MERASX /BACK TO REGISTER GLK /OVERFLOW BIT DCA MSIGN /SAVE OVERFLOW BIT ISZ MERAS /UPDATE WORD COUNTER JMP C48A /RETURN FOR MORE JMP I C48 /RETURN WITH COMP # IN AC-MQ MERASX, 0 MERAS, 0 MSIGN, 0 M30, -30 MSHCT, 0 / AMSHCT, ACHW-1 AMQLW, MQLW XCOMP, COMP / / /----------------------------------------------------------------------------- / CDBLW - CONVERT SINGLE WORD TO DOUBLE PRECISION NUMBER WITH SIGN EXTENSION /----------------------------------------------------------------------------- / / CNVDBL /CONVERT SINGLE TO DOUBLE WORD WITH SIGN EXTENSION / ADDR1 /ADDRESS OF WORD TO BE CONVERTED / ADDR2 /ADDRESS OF WHERE TO STORE CONVERTED WORDS (HIGH,LOW) / CDBLW, 0 TAD I CDBLW /GET ADDRESS OF WORD TO BE CONVERTED DCA CDBLW1 /SAVE ADDRESS ISZ CDBLW /UPDATE POINTER TAD I CDBLW /GET THE ADDRESS OF WHERE TO STORE WORDS DCA CDBLW2 /SAVE THE ADDRESS ISZ CDBLW /UPDATE POINTER FOR RETURN TAD I CDBLW1 /GET THE WORD TO BE CONVERTED SPA CLA /SIGN EXTEND IT ? CLA CLL CMA /YES DCA I CDBLW2 /SAVE THE SIGN EXTENSION ISZ CDBLW2 /UPDATE POINTER TO LOW PART OF WORD TAD I CDBLW1 /GET THE WORD TO BE CONVERTED DCA I CDBLW2 /STORE IT AS LOW PART OF DOUBLE WORD JMP I CDBLW /EXIT - WORD CONVERTED TO DOUBLE PRECISION / CDBLW1, 0 CDBLW2, 0 / SCRNON, 417; 26 /SCREEN FLASH MODE OFF, SCREEN ENABLE 7777 / SCRNOF, 416; 6 /SCREEN FLASH MODE ON AND SCREEN DISABLE 7777 / PAGE /----------------------------------------------------------------------------- / TDIV - DOUBLE PRECISION SIGNED DIVIDE - QUOTIENT IN MQ - REMAINDER IN ACHW-ACLW /----------------------------------------------------------------------------- / / SETUP ACHW-MQLW PRIOR TO CALL (48 BIT WORD) / DBLDIV /CALL DOUBLE PRECISION DIVIDE / ADDR1 /ADDRESS OF DOUBLE WORD DIVISOR /---NOTE:-----DIVIDE BY 0 NOT CHECKED - PROTECTED BY CODE OUTSIDE OF ROUTINE---- TDIV, 0 CLA CLL DCA DSGN /INITIALIZE SIGN FLAG TAD I TDIV /GET ADDRESS OF DIVISOR DCA TERAS /SAVE THE ADDRESS OF HIGH ORDER DIVISOR ISZ TDIV /UPDATE RETURN POINTER FOR EXIT TAD I TERAS /GET HIGH ORDER DIVISOR DCA SRH /SAVE THE HIGH ORDER DIVISOR ISZ TERAS /UPDATE POINTER TO LOW ORDER WORD TAD I TERAS /GET THE LOW ORDER DIVISOR DCA SRL /SAVE THE LOW WORD DIVISOR / / NOW CHECK THE SIGN ON EVERYTHING / TAD ACHW /GET THE HIGH ORDER AC SMA CLA /IS IT NEGATIVE JMP .+3 /NO ISZ DSGN /YES ... SET SIGN SWITCH JMS I IC48 /YES - COMPLEMENT 48 BIT WORD TAD SRH /COPY SR TO -SR (MSR) DCA MSRH /SAVE TAD SRL /LOW WORD DCA MSRL /SAVE IT TAD SRH /GET HIGH ORDER SR SMA CLA /IS IT NEGATIVE JMP .+5 /NO....COMPLEMENT -SR ISZ DSGN /YES...SET SIGN SWITCH JMS I ICOM /COMPLEMENT SR SRH JMP .+3 JMS I ICOM /COMPLEMENT MSR IF POSITIVE MSRH / / CHECK IF DIVISOR IS LARGER THEN DIVIDEND / TAD ACHW /GET MOST SIGNIFICANT WORD SZA CLA /NON - ZERO JMP DODIVD /YES - DEFINATELY BIGGER TAD ACLW /GET NEXT LEAST SIGNIFICANT WORD SZA CLA /NON-ZERO JMP DODIVD /YES - DEFINATELY BIGGER THEN DIVISOR TAD MQHW /GET THE 3RD WORD OF DIVIDEND SMA CLA /CHECK IF MSB SET JMP .+4 /NO - GO CHECK IF DIVISOR <= DIVIDEND TAD SRH /CHECK IF DIVISOR MSB SET SMA CLA /SKIP IF YES - THEN OK TO DO REGULAR CHECK JMP DODIVD /DIVIDEND DEFINATELY BIGGER THEN DIVISOR TAD SRH /GET THE DIVISOR CIA /NEGATE IT TAD MQHW /GET NEXT SIGNIFICANT WORD OF DIVIDEND SPA /DIVISOR > DIVIDEND JMP RSLT0 /YES - FRACTION RETURN WITH RESULT OF 0 SZA CLA /HIGH WORD OF DIVISOR = 3RD WORD OF DIVIDEND JMP DODIVD /NO - DIVISOR < DIVIDEND TAD MQLW /GET THE FORTH WORD OF DIVIDEND SMA CLA /CHECK IF MSB SET JMP .+4 /NO - GO CHECK IF DIVISOR <= DIVIDEND TAD SRL /CHECK IF DIVISOR MSB SET SMA CLA /SKIP IF YES - GO CHECK LOW WORD OF DIVIDEND JMP DODIVD /DIVIDEND DEFINITELY BIGGER THEN DIVISOR TAD SRL /LOW WORD OF DIVISOR CIA /NEGATE IT TAD MQLW /LOW WORD OF DIVIDEND SMA CLA /DIVISOR > DIVIDEND JMP DODIVD /NO DIVISOR <= DIVIDEND RSLT0, CLA CLL TAD MQHW /GET THIRD WORD OF DIVIDEND DCA ACHW /SAVE IT AS A REMAINDER TAD MQLW /GET FORTH WORD OF DIVIDEND DCA ACLW /SAVE IT AS A REMAINDER DCA MQHW /ZERO THE 24 BIT QUOTIENT DCA MQLW / JMP DIVEND /GO DO ROUND OFF IF NEEDED DODIVD, TAD DM30 /-24 DCA DSHC /-24 TO SHIFT COUNTER / THIS BEGINS THE ACTUAL DIVIDE / / FIRST SHIFT AC-MQ LEFT ONE PLACE / DLP, CLA CLL CML /SET THE LINK TAD M0004 /-4 DCA TERAS /SAVE TO INDEX LOCATION TAD DMQLW /ADDRESS OF LOW ORDER MQ DCA TERASX /SAVE TO ADDRESS INDEX LOCATION / DLP1, CLA CML TAD I TERASX /WORD FROM 48 BIT REGISTER RAL /SHIFT LEFT ONE DCA I TERASX /SAVE AS NEW WORD CLA CMA /-1 TAD TERASX /ADDRESS OF PRESENT WORD DCA TERASX /SAVE AS TO LOOK AT NEW WORD ISZ TERAS /DONE ALL 4 WORDS JMP DLP1 /NO - DO NEXT PART OF 48 BIT WORD / / CHECK TO SEE IF AC >= SR / CLA CLL TAD SRH /-HIGH ORDER SR CIA TAD ACHW /+HIGH ORDER AC SNA JMP .+4 /MORE TESTS IF HIGH ORDER EQUAL SMA CLA /IS AC>SR JMP SRTC /YES...GO DO SUBTRACT JMP INDX /NO ...GO TO INDEX SHIFT COUNTER CLA CLL TAD SRL /-LOW ORDER SR CMA CML IAC /USE LINK AS 13 BIT AC TAD ACLW /+LOW ORDER AC SZL CLA /LINK IS SIGN BIT ... IS AC>=SR JMP INDX /NO ... INDEX SHIFT COUNTER / NOW SUBTRACT SR FROM THE AC / SRTC, CLA CLL TAD ACLW /LOW ORDER TAD MSRL / DCA ACLW /SAVE GLK /GET THE CARRY TAD ACHW /HIGH ORDER TAD MSRH DCA ACHW /SAVE ISZ MQLW /INDEX LOW ORDER MQ TO ACOUNT FOR DIVISION INDX, ISZ DSHC /UPDATE SHIFT COUNTER JMP DLP /DO IT AGAIN / / DIVISION COMPLETE / CHECK THE SIGN OF THE RESULT / DIVEND, JMS I XRNDOF /GO ROUND UP QUOTIENT IF NEEDED TAD DSGN /GET THE SIGN FLAG RAR /IS IT ODD SNL CLA / JMP I TDIV /NO.... RESULT + .... EXIT JMS I ICOM /YES... COMPLEMENT RESULT MQHW JMP I TDIV /EXIT MQ CONTAINS THE QUOTIENT / DM30, -30 ICOM, COMP IC48, C48 DSHC, 0 MSRH, 0 MSRL, 0 DSGN, 0 TERASX, 0 TERAS, 0 / DMQLW, MQLW XRNDOF, RNDOFF / PAGE / / SPOC - POWER-ON-CLEAR GDC INITIALIZATION STRING / SPOC2N, SPOC2O, 417; 26; 62; 143; 4; 3; 3; 360; 114; 7777 /SYNC(DMII OLD BOARD) SPOC3N, 417; 26; 62; 143; 4; 4; 3; 360; 110; 7777 /SYNC(DMIII NEW BOARD) / SPOC, 557 /VSYNC 507; 100 /PITCH 560; 0; 0; 0; 17; 0; 0; 0; 0 /PRAM 513; 0 /CCHAR 506; 0 /ZOOM 553 /START 511; 0; 0; 0 /CURS TO HOME 7777 /TERMINATOR / ERASE THE SCREEN / SERASE, 514; 2; 377; 77 /FIGS 512; 377; 377 /MASK 440; 0; 0 /WDAT (REPLACE MODE) 7777 /TERMINATOR / / LINE PARAMETERS / LINPAT, 570; 377; 377 /PRAM (MODIFIED IN CODE) 7777 /TERMINATOR / -------------------------------------------------------------------- / SPDTXT - SPECIAL CASE CODE FOR CHARACTER IN REPLACE AND NON-ITALIC / -------------------------------------------------------------------- / SPDTXT, 0 TAD QCELIT /CHECK IF ITALICIZED SZA CLA JMP SPDTX8 /YES, CAN'T TAKE ADVANTAGE OF THIS CODE / ACNEG1 /CHECK IF REPLACE WRITING MODE TAD WRMODE SZA CLA JMP SPDTX8 /NO, CAN'T TAKE ADVANTAGE / TAD NEGFLG /CHECK IF ALSO NON-NEGATE SZA CLA JMP SPDTX8 /NO, CAN'T TAKE ADVANTAGE / TAD PPSTEX /OK TO DRAW CELL FIRST, BUILD FIGS STRING DCA AUTO10 / TAD KK0020 /P1 = AREA FILL AND DIRECTION TAD QCELRT DCA I AUTO10 / CDF TBLFLD /GET PHYSICAL HEIGHT AND WIDTH TAD I PGDCHT /HEIGHT DCA TEMP /SAVE FOR A WHILE ACNEG1 TAD I PGDCWD /WIDTH CDF PRGFLD JMS I XXXXSD /DC = WIDTH-1 / TAD TEMP /D = HEIGHT JMS I XXXXSD / TAD TEMP /D2 = HEIGHT JMS I XXXXSD / BLDPOS /BUILD THE CURS STRING SPOSIT / DRAWIT /DRAW THE CELL SPOSIT PPSTEX, STEXT TXTPT0 / DCA WRMODE /FORCE OVERLAY MODE FOR THE REMAINDER / OF THIS CHARACTER DRAW SPDTX8, JMP I SPDTXT /RETURN / KK0020, 0020 XXXXSD, SAVEDX PGDCWD, ZGDCWD PGDCHT, ZGDCHT / ------------------------------------------------------- / STROW - DO SOME PRELIMINARY WORK FOR THIS CHARACTER ROW / ------------------------------------------------------- / / STROW, 0 / TAD PSTXT3 /POINT INTO FIGS STRING DCA AUTO10 / AC0004 /CHECK TEXT BASELINE ANGLE AND QCELRT CLL RTR /UPSIDE DOWN MAKES A ONE TAD YPOS1 /CHECK Y POSITION TO SEE HOW BIG DOT IS AND K0001 /ODD SIZES GET A LITTLE BIGGER OR SMALLER TAD QTXTD / NOTE ONLY VERTICAL DIRECTION REQUIRES THIS CLL RAR /DIVIDE BY TWO DCA TEMP /SAVE FOR SENDING TWICE / TAD TEMP /GET HEIGHT OF DOT JMS I XXSVDX /SAVE AS FIGS D PARAMETER / TAD TEMP /GET HEIGHT OF DOT AGAIN JMS I XXSVDX /SAVE AS FIGS D2 PARAMETER / JMP I STROW /RETURN / / XXSVDX, SAVEDX PSTXT3, STEXT+3 K0001, 0001 WOPTBF, ZBLOCK 14 /WRITE OPTIONS BUFFER / / PAGE /----------------------------------------------------------------------------- / PWRUP - POWER-UP-CLEAR /------------------------------------------------------------------------------ / / INITIALIZES GRAPHICS BOARD REGISTERS ONE AND TWO, / SENDS INITIALIZATION CODE TO THE GDC CONTROLLER / PWRUP, 0 / AC1 /DISABLE THE CURSOR UNTIL AFTER INIT SEQ DCA CURFLG /SAVE THE CURSOR FLAG / CIF TBLFLD /AUXILIARY FIELD FOR ROUTINE JMS I XPWRAU / TAD GRFX /CHECK IF BOARD PRESENT SNA CLA JMP PWRUP9 /IF NOT, SKIP REST OF POWER-ON / TAD PSPOC /GET APPROPRIATE SYNC STRING TAD DECMAT / BASED ON DECMATE II OR III TAD GOBTYP / AND ON GRAPHICS OPTION BOARD TYPE DCA TEMP /SAVE ADDRESS IN TABLE TAD I TEMP /GET STRING ADDRESS FROM TABLE DCA PWRUP4 /SAVE FOR SUBSEQUENT EXECUTION / SENDIT /SEND SYNC STRING PWRUP4, 0 /(BECOMES POINTER TO SYNC STRING) SENDIT /SEND REMAINDER OF POC STRING SPOC / JMS WVSYNC /WAIT FOR TWO VERTICAL SYNC'S / TAD GOBTYP /CHECK TYPE OF BOARD SZA CLA TAD K3000 /NEW BOARD, BUILD A 7000 TAD KK4000 / OR OLD BOARD MAKES A 4000 DCA REG1HI /SAVE AS REG 1 VALUE JMS SYNCH /SYNCHRONIZE THE TWO VIDEOS / TAD GOBTYP /CHECK TYPE OF BOARD SZA CLA JMP PWRUP9 /NEW BOARD, ALL DONE / LDREG2 /WRITE REGISTER TWO FOR OLD BOARD 3567 / (NO TEXT TO COLOR) / PWRUP9, JMP I PWRUP /RETURN / / PSPOC, SPOCLS SPOCLS, SPOC2O /DECMATE II OLD BOARD SPOC2N /DECMATE II NEW BOARD SPOC3N /DECMATE III NEW BOARD KK4000, 4000 K3000, 3000 XPWRAU, PWRAUX / -------------------------------------------- / SYNCH - SYNCHRONIZE GRAPHICS AND TEXT VIDEOS / -------------------------------------------- / SYNCH, 0 / TAD K1400 /SET GRAPHICS BOARD FOR EXTERNAL SYNC GRW1 / JMS WVSYNC /WAIT FOR TWO VERTICAL SYNCS / TAD KK1000 /DESELECT VERTICAL SYNC GRW1 / LDREG1 /LOAD REGISTER 1 71 /ALSO PLANES 3, 2, AND 1 / JMP I SYNCH /RETURN / / K1400, 1400 KK1000, 1000 /----------------------------------------------------------------------------- / WVSYNC - WAIT FOR TWO VERTICAL SYNC'S TO SYNC UP GDC AND EXTERNAL HARDWARE /----------------------------------------------------------------------------- WVSYNC, 0 CLA CLL /CLEAR THE LINK - USED TO COUNT WVSYN1, GRGR /READ THE STATUS REGISTER BSW /PUT VERTICAL SYNC INTO SIGN BIT SMA CLA /SKIP IF A ONE JMP WVSYN1 /NOT A ONE - WAIT FOR IT TO SET WVSYN2, GRGR /READ VERTICAL SYNC BSW /PUT VERTICAL SYNC INTO SIGN BIT SPA CLA /WAIT FOR VERTICAL SYNC TO GO AWAY JMP WVSYN2 /NOT A ZERO - WAIT FOR IT TO CLEAR CML /COMPLEMENT THE LINK SZL /SKIP IF 2ND TIME THROUGH THE LOOP JMP WVSYN1 /1ST TIME - WAIT FOR ANOTHER VERTICAL SYNC JMP I WVSYNC /EXIT - 2 VERTICAL SYNC'S OCCURED / ------------------------------------- / WGREG1 - WRITE TO GRAPHICS REGISTER 1 / ------------------------------------ / / THE VALUE TO WRITE FOLLOWS THE CALL / WGREG1, 0 CLA CLL SENDIT /SEND A DUMMY COMMAND TO GDC DUMMY WTDON1, GRGR /ROTATE FIFO EMPTY TO LINK RTR RAR SNL CLA JMP WTDON1 /NOT EMPTY YET - WAIT AGAIN TAD I WGREG1 /GET THE VALUE TO BE WRITTEN AND K0077 /MASK TO LOW SIX BITS TAD REG1HI /SET APPROPRIATE HIGH SIX BITS DCA REG11 /SAVE FOR USE BY REG 2 ROUTINE TAD REG11 GRW1 /WRIE DATA TO REGISTER 1 CLA CLL ISZ WGREG1 /UPDATE THE RETURN POINTER JMP I WGREG1 /RETURN / ------------------------------------ / WGREG2 - WRITE TO GRAPHICS REGISTER 2 / ------------------------------------ / / THE VALUE TO WRITE FOLLOWS THE CALL / WGREG2, 0 CLA CLL TAD I WGREG2 /GET THE VALUE TO WRITE ISZ WGREG2 /INCREMENT TO CORRECT RETURN ADDRESS DCA REG12 /SAVE IT / TAD M0004 /SET UP COUNTER FOR ALL 4 REGS 2 DCA R2CNTR / DCA R2PTR /POINT TO REG 2A FIRST / WGRG2A, TAD REG11 /REG 1 POINTS TO REG 2 TAD R2PTR GRW1 /WRITE REG 1 / CLA CLL TAD REG12 /GET VALUE TO WRITE TO REG 2 GRW2 /AND WRITE IT / AC100 /BUMP REG 1 POINTER TO NEXT REG 2 TAD R2PTR DCA R2PTR / ISZ R2CNTR /LOOP THROUGH ALL FOUR REGS 2 JMP WGRG2A / TAD REG11 /ENSURE REG1 POINTS TO REG 2A GRW1 CLA CLL / JMP I WGREG2 /RETURN / / REG11, 0 REG12, 0 R2PTR, 0 R2CNTR, 0 / ANOTHER FIELD OF CODE / / TO AVOID CONFLICT WITH REGIS MODULE, WHICH SHARES THIS FIELD, USE PAGE ZERO / ADDRESSES ABOVE 0060 ONLY, USE AUTOINDEXING REGISTERS 0017 DOWNWARD, USE / MEMORY ABOVE ADDRESS 4000 ONLY. / FIELD TABFLD / *0060 /PAGE ZERO VARIABLES, CONSTANTS, DATA, ETC. / ZOPCOD, 0 /CURRENT OPCODE ZCBFLD, 0 /FIELD OF CONTROL BLOCK (^10) ZCBPTR, 0 /ADDRESS OF CONTROL BLOCK / TXTSIZ= ZTXTD-ZCHRST+1 ZTXTSZ= ZYPV2-ZCHRST+1 / ZCHRST, 0 /DISPLAY ALPHABET ZCELRT, 0 /CELL ROTATION (0 - 359 DEGREES AT ENTRY, / SIMPLIFY TO 0 - 7) ZCELHT, 0 /CELL HEIGHT IN LOGICAL PIXELS ZCELWD, 0 /CELL WIDTH IN LOGICAL PIXELS ZUNIHT, 0 /UNIT HEIGHT IN LOGICAL PIXELS ZUNIWD, 0 /UNIT WIDTH IN LOGICAL PIXELS ZCELIT, 0 /CELL ITALIC (0 - 359 DEGREES AT ENTRY, / SIMPLIFY TO -2, -1, 0, +1, +2) ZCELFG, 0 /FLAG FOR CHARACTER ESCAPEMENT: / 0000 - BASELINE ANGLE, / 7777 - ABSOLUTE ESCAPEMENT, / 0001 - NO CHANGE ZBASAN, 0 /BASELINE ANGLE (0 - 359 DEGREES AT ENTRY, / SIMPLIFY TO 0 - 7) ZXESC, 0 /X ESCAPEMENT IN LOGICAL PIXELS ZYESC, 0 /Y ESCAPEMENT IN LOGICAL PIXELS ZXLFES, 0 /X LINEFEED ESCAPEMENT IN LOGICAL PIXELS ZYLFES, 0 /Y LINEFEED ESCAPEMENT IN LOGICAL PIXELS DOTSHI, 0 /# DOTS DOWN CHARACTER DOTSWD, 0 /# DOTS ACROSS CHARACTER DTHTCL, 0 /# DOTS DOWN CELL (THAT FIT) DTWDCL, 0 /# DOTS ACROSS CELL (THAT FIT) ZTXTDC, 0 /1X DOT WIDTH ZTXTD, 0 /2X DOT HEIGHT / ZXKI, 0 /X DISPLACEMENT PER CHARACTER DOT COLUMN ZXKJ, 0 /X DISPLACEMENT PER CHARACTER DOT ROW ZYKI, 0 /Y DISPLACEMENT PER CHARACTER DOT COLUMN ZYKJ, 0 /Y DISPLACEMENT PER CHARACTER DOT ROW / ZXUNHT, 0 /X COMPONENT OF UNIT HEIGHT ZXUNWD, 0 /X COMPONENT OF UNIT WIDTH ZYUNHT, 0 /Y COMPONENT OF UNIT HEIGHT ZYUNWD, 0 /Y COMPONENT OF UNIT WIDTH / ZGDCWD, 0 /PHYSICAL CELL WIDTH ZGDCHT, 0 /PHYSICAL CELL HEIGHT / DELX, 0 /X DIMENSION OF CELL (-1) DELY, 0 /Y DIMENSION OF CELL (-2) / ZXCLWD, 0 /X COMPONENT OF CELL WIDTH ZXCLHT, 0 /X COMPONENT OF CELL HEIGHT ZYCLWD, 0 /Y COMPONENT OF CELL WIDTH ZYCLHT, 0 /Y COMPONENT OF CELL HEIGHT / ZPVROT, 0 /CELL ROTATION FOR TEXT PIXEL VECTORS ZXPV0, 0 /X COMPONENT OF TEXT PIXEL VECTOR '0' ZXPV2, 0 /X COMPONENT OF TEXT PIXEL VECTOR '2' ZYPV0, 0 /Y COMPONENT OF TEXT PIXEL VECTOR '0' ZYPV2, 0 /Y COMPONENT OF TEXT PIXEL VECTOR '2' / SIGNFG, 0 /SIGN FLAG FOR MULT AND DIV (LSB COUNTS) / ZTEMP, 0 /TEMPORARY VARIABLES ZTEMP1, 0 / XZGTPR, ZGTPRM XROTAT, ROTATE XMOVE, MOVE / ZKCDF, CDF / ZK0002, 0002 ZK0004, 0004 ZK0005, 0005 ZK0007, 0007 ZK0010, 0010 ZK0011, 0011 ZK0012, 0012 ZK0024, 0024 ZK0026, 0026 ZK0036, 0036 ZK0070, 0070 ZK0550, 0550 / ZM0004, -0004 ZM0005, -0005 ZM0010, -0010 ZM0012, -0012 ZM0015, -0015 ZM0020, -0020 ZM0024, -0024 ZM0036, -0036 ZM0055, -0055 ZM0550, -0550 *ZENTRY /BEGINNING OF CODE IN THIS FIELD / / ------------------------------- / ZENTRY - ENTRY POINT DISPATCHER / ------------------------------- / / CALLING FORMAT: / DATA FIELD = CALLING FIELD / INSTRUCTION FIELD = THIS FIELD / JMS I (ZENTRY / OPCODE / FIELD OF CONTROL BLOCK / ADDRESS OF CONTROL BLOCK / ZENTRY, 0 / CLA CLL TAD I ZENTRY /GET OPCODE FROM CALLING FIELD DCA ZOPCOD /SAVE IT ISZ ZENTRY /BUMP ADDRESS / TAD I ZENTRY /GET CONTROL BLOCK FIELD AND ZK0070 /MASK TO FIELD BITS DCA ZCBFLD /SAVE IT ISZ ZENTRY / TAD I ZENTRY /GET CONTROL BLOCK POINTER DCA ZCBPTR /SAVE IT ISZ ZENTRY /BUMP TO CORRECT RETURN ADDRESS / CDF TBLFLD /NOW SET TO OUR DATA FIELD / TAD ZOPCOD /SET UP FOR DISPATCH TO PRIMITIVE ROUTINE TAD PZTABL / BY ADDING OPCODE TO TABLE BASE ADDRESS DCA ZTEMP /SAVE POINTER TO ROUTINE ADDRESS TAD I ZTEMP /GET ROUTINE ADDRESS DCA ZTEMP /SAVE IT JMS I ZTEMP /CALL THAT ROUTINE / CLA CLL CDF CIF PRGFLD /SET DATA AND INSTRUCTIONS TO BASE / PRIMITIVES FIELD JMP I ZENTRY /RETURN TO BASE PRIMITIVES / / PZTABL, ZTABLE / -------------------------------------------------- / NRMANG - NORMALIZE ANGLE TO 0 THROUGH 359. DEGREES / -------------------------------------------------- / NRMANG, 0 / NRMAN2, SPA /CHECK IF ANGLE NEGATIVE JMP NRMAN4 /IF SO, GO MAKE IT POSITIVE TAD ZM0550 /IF NOT, ADD -360. UNTIL IT IS JMP NRMAN2 /REPEAT UNTIL ANGLE IS NEGATIVE / NRMAN4, SMA /CHECK IF ANGLE NEGATIVE JMP NRMAN6 /IF NOT, THEN ITS OK TAD ZK0550 /IF SO, ADD +360. UNTIL ITS POSITIVE JMP NRMAN4 /REPEAT UNITL ANGLE IS POSITIVE / NRMAN6, JMP I NRMANG /RETURN WITH NORMALIZED ANGLE / ---------------------------------- / TXTSTP - GET TEXT SETUP PARAMETERS / ---------------------------------- / TXTSTP, 0 / CLA CLL JMS I XZGTPR /GET THE DISPLAY ALPHABET SPA /ENSURE IN THE RANGE 0 - 3 CLA /TOO LOW, DEFAULT TO ZERO TAD ZM0004 /CHECK HIGH RANGE NOW SMA JMP TXTS90 /TOO HIGH, ABORT TAD ZK0004 /RESTORE ALPHABET NUMBER DCA ZCHRST /SAVE IT / JMS I XZGTPR /GET THE CELL ROTATION ANGLE JMS NRMANG /NORMALIZE TO 0. TO 359. DEGREES DCA ZCELRT /SAVE IT / JMS I XZGTPR /GET THE CELL HEIGHT SMA /CHECK IF POSITIVE JMP TXTST2 /OK CLA /TOO LOW, DEFAULT TO 20. TAD ZK0024 TXTST2, JMS CLP620 /ENSURE VALUE NOT OVER 400. DCA ZCELHT /SAVE IT / JMS I XZGTPR /GET THE CELL WIDTH SMA /CHECK IF POSITIVE JMP TXTST4 /OK CLA /TOO LOW, DEFAULT TO 9. TAD ZK0011 TXTST4, JMS CLP620 /ENSURE VALUE NOT OVER 400. DCA ZCELWD / JMS I XZGTPR /GET THE UNIT HEIGHT SMA /CHECK IF POSITIVE JMP TXTST6 /OK CLA /TOO LOW, DEFAULT TO 20. TAD ZK0024 TXTST6, JMS CLP620 /ENSURE VALUE NOT OVER 400. DCA ZUNIHT /SAVE IT / JMS I XZGTPR /GET THE UNIT WIDTH SPA /CHECK IF POSITIVE AC0010 /TOO LOW, DEFAULT TO 8. JMS CLP620 /ENSURE VALUE NOT OVER 400. DCA ZUNIWD / JMS I XZGTPR /GET THE CELL ITALIC ANGLE DCA ZCELIT /SAVE IT / JMS I XZGTPR /GET THE FLAG FOR ESCAPEMENT SPECIFIER DCA ZCELFG /SAVE IT / TAD ZCELFG /CHECK IF BASELINE ANGLE SPECIFIED SZA CLA JMP TXTS10 /NO, SKIP TO CHECK FOR ABSOLUTE ESCAPEMENT / JMS I XZGTPR /GET THE BASELINE ANGLE JMS NRMANG /NORMALIZE TO 0. TO 359. DEGREES DCA ZBASAN /SAVE IT JMP TXTS20 /SKIP AROUND / TXTS10, TAD ZCELFG /CHECK IF ABSOLUTE ESCAPEMENT SPECIFIED SMA CLA JMP TXTS20 /NO, SKIP AROUND / JMS I XZGTPR /GET THE X ESCAPEMENT DCA ZXESC /SAVE IT / JMS I XZGTPR /GET THE Y ESCAPEMENT DCA ZYESC /SAVE IT / TXTS20, JMS ZSIMPL /CREATE WORKING PARAMETERS FROM ARGUMENTS / JMS I XZCOPY /COPY TEXT PARAMETERS TO MAIN FIELD FOR USE / TXTS90, CLA CLL /THAT'S ALL JMP I TXTSTP /RETURN / / XZCOPY, ZCOPYT / ------------------------------------------------------- / CLP620 - CLIP VALUE IN AC TO 400 DECIMAL (IF OVER 400.) / ------------------------------------------------------- / CLP620, 0 / SPA /CHECK IF AC > 2047. JMP CL620A /IF SO, GO FORCE TO 400. / TAD ZM0620 /CHECK IF AC > 400. SMA CL620A, CLA /AC TOO BIG, ENSURE LATER CORRECTION MAKES 400. TAD ZK0620 /RESTORE AC (MAY BE CHANGED TO 400.) JMP I CLP620 /RETURN WITH VALUE IN AC / / ZK0620, 0620 ZM0620, -0620 / --------------------------------------------------- / ZGTPRM - GET PARAMETERS FROM ORIGINAL CALLING FIELD / --------------------------------------------------- / ZGTPRM, 0 / CLA CLL TAD ZCBFLD /CREATE A CDF INSTRUCTION TAD ZKCDF / FOR THE ORIGINAL CALLING FIELD DCA ZGTPR4 /SAVE INSTRUCTION IN LINE / ZGTPR4, 0 /BECOMES CDF INSTRUCTION / TAD I ZCBPTR /GET A WORD FROM THAT FIELD ISZ ZCBPTR /BUMP POINTER FOR NEXT CALL, IF ANY CDF TBLFLD /SET BACK TO OUR OWN DATA FIELD / JMP I ZGTPRM /RETURN WITH PARAMETERS IN AC / / / / / ------------------------------------------------------------- / ZSIMPL - SIMPLIFY ARGUMENTS FROM TEXT PARAMETER SETUP COMMAND / ------------------------------------------------------------- / ZSIMPL, 0 JMS I X2SIMP /HANDLE CELL SIZING AND ROTATION / JMS I X3SIMP /HANDLE CELL ESCAPEMENTS / JMS I X4SIMP /PRECOMPUTE TEXT DOT DRAWING PARAMETERS / JMS I X5SIMP /PRECOMPUTE TEXT PIXEL VECTOR DISPLACEMENTS / JMS I X6SIMP /PRECOMPUTE CELL BOUNDARIES / JMP I ZSIMPL /RETURN / / X2SIMP, Z2SIMP X3SIMP, Z3SIMP X4SIMP, Z4SIMP X5SIMP, Z5SIMP X6SIMP, Z6SIMP PAGE / / ---------------------------------------- / Z2SIMP - SIMPLIFY CELL SIZING PARAMETERS / ---------------------------------------- / Z2SIMP, 0 / /SIMPLIFY CELL ROTATION FROM DEGREES / TO OCTANT (0 DEG -> 0, / 45 DEG -> 1, ETC.) DCA ZTEMP /INITIALIZE WORKING OCTANT NUMBER TAD ZCELRT /GET ANGLE IN DEGREES ZSIMP2, TAD ZM0055 /KEEP SUBTRACTING 45. DEGREES SPA JMP ZSIMP4 /UNTIL ANGLE IS NEGATIVE / ISZ ZTEMP /INCREMENT OCTANT NUMBER FOR EACH SUBTRACTION /(NEVER SKIPS) JMP ZSIMP2 /GO BACK TO SUBTRACT ANOTHER 45. DEGREES / ZSIMP4, CLA CLL TAD ZTEMP /HAVE OCTANT AND ZK0007 /MASK TO APPROPRIATE BITS DCA ZPVROT /SAVE FOR LATER TECT PIXEL VECTOR COMPUTATIONS / AC0006 /KNOW THE OCTANT BY NOW, MASK TO NEXT LOWER AND ZTEMP / QUADRANT DCA ZCELRT /SAVE IT FOR USE BY TEXT ROUTINES / /SIMPLIFY UNIT HEIGHT BY ROUNDING TO / ACTUAL WORKING VALUE / 0 -> 20. (DEFAULT) / 1-19 -> 10. / 20-29 -> 20. DCA ZTEMP1 /INITIALIZE WORKING QUOTIENT (FOR #/10.) TAD ZUNIHT /CHECK IF HEIGHT SPECIFIED AS 0 (DEFAULT) SNA TAD ZK0024 /IF SO, USE DEFAULT / ZSIMP6, TAD ZM0012 /KEEP SUBTRACTING 10. 'PIXELS' SPA / UNTIL HEIGHT IS NEGATIVE JMP ZSIMP8 / ISZ ZTEMP1 /INCREMENT WORKING QUOTIENT /(NEVER SKIPS) JMP ZSIMP6 /GO BACK TO SUBTRACT ANOTHER 10. / ZSIMP8, CLA CLL /KNOW HOW MANY TENS THERE ARE IN HEIGHT TAD ZTEMP1 SNA /CHECK IF HALF HEIGHT (0-9 PIXELS ->10.) AC1 /IF SO, MAKE HALF HEIGHT DCA ZTEMP1 / TAD ZTEMP1 /MULTIPLY BY 10. TO GET LOGICAL PIXELS CLL RTL TAD ZTEMP1 CLL RAL DCA ZUNIHT /SAVE IT /SIMPLIFY UNIT WIDTH BY ROUNDING TO / ACTUAL WORKING VALUE / 0 -> 8. (DEFAULT) / 1-7 -> 4. (OR 8. IF 90 ROT) / 8-15 -> 8. DCA ZTEMP1 /INITIALIZE WORKING QUOTIENT (FOR #/8.) TAD ZUNIWD /CHECK IF WIDTH SPECIFIED AS 0 (DEFAULT) SNA TAD ZK0010 /IF SO, USE DEFAULT / ZSIM10, TAD ZM0010 /KEEP SUBTRACTING 8. 'PIXELS' SPA / UNTIL WIDTH IS NEGATIVE JMP ZSIM12 / ISZ ZTEMP1 /INCREMENT WORKING QUOTIENT /(NEVER SKIPS) JMP ZSIM10 /GO BACK TO SUBTRACT ANOTHER 8. / ZSIM12, CLA CLL /KNOW HOW MANY EIGHTS THERE ARE IN WIDTH TAD ZTEMP1 /MULTIPLY BY 8. TO GET LOGICAL PIXELS CLL R3L SNA /CHECK IF HALF WIDTH AC0004 /SET HALF WIDTH IF SO DCA ZUNIWD /SAVE IT / AC0002 /CHECK IF CHARACTER ROTATION 90 OR 270 AND ZCELRT /(WILL BE 2,3,6,7 IF SO) SNA CLA JMP ZSIMI3 /NO, ALL DONE WITH WIDTH TAD ZM0004 /YES, CHECK IF WIDTH IS FOUR TAD ZUNIWD SZA CLA JMP ZSIMI3 /NO, ALL DONE WITH WIDTH AC0010 /YES, CAN'T USE FOUR WITH THIS ROTATION DCA ZUNIWD / USE EIGHT INSTEAD /SIMPLIFY CELL ITALIC ANGLE FROM DEGREES TO / ACTUAL WORKING VALUE / 0 DEGREES -> 0, / 1 - 30 DEGREES -> +1, / >= 31 DEGREES -> +2, / -1 - -30 DEGREES -> -1, / <= -31 DEGREES -> -2 ZSIMI3, TAD ZCELIT /GET ITALIC ANGLE IN DEGREES SNA /CHECK FOR ZERO JMP ZSIM18 /IS ZERO, GO SAVE A ZERO / TAD ZK0036 /CHECK IF LESS THAN -30 DEGREES SMA JMP ZSIM14 /NO, GO CHECK SOME MORE AC7776 /YES, SAVE A NEGATIVE TWO JMP ZSIM18 / ZSIM14, TAD ZM0036 /CHECK IF BETWEEN -30 AND -1 (INCLUSIVE) SMA JMP ZSIM16 /NO, GO CHECK SOME MORE ACNEG1 /YES, SAVE A NEGATIVE ONE JMP ZSIM18 / ZSIM16, TAD ZM0036 /CHECK IF BETWEEN +1 AND +30 (INCLUSIVE) SMA CLA /SKIP IF SO AC1 /IS GREATERTHAN/EQUAL TO +31 IAC /MAKES 1 - 30 INTO +1, >= 31 INTO +2 ZSIM18, DCA ZCELIT /SAVE THE SIMPLIFIED CELL ITALIC /DETERMINE NUMBER OF DOTS TO DRAW / FOR EACH DIRECTION AC0010 /ASSUME OK TO DRAW EIGHT DOTS ACROSS DCA DOTSWD TAD ZK0012 /ASSUME OK TO DRAW TEN DOTS UP AND DOWN DCA DOTSHI / AC0002 /CHECK IF CELL ROTATION IS 0 OR 180 AND ZCELRT /(ARE CODED AS 0 AND 4) SZA CLA JMP Z2SM20 /MUST BE 90 OR 270 / TAD ZM0010 /CHECK IF WIDTH < EIGHT TAD ZUNIWD SMA CLA JMP Z2SM10 /NO, GO CHECK HEIGHT AC0004 /WIDTH TOO SMALL, DRAW ONLY FOUR DOTS DCA DOTSWD / Z2SM10, TAD ZM0024 /CHECK IF HEIGHT < TWENTY TAD ZUNIHT SMA CLA JMP Z2SM40 /NO, THAT'S ALL HERE TAD ZK0005 /HEIGHT TOO SMALL, DRAW ONLY FIVE DOTS HIGH DCA DOTSHI JMP Z2SM40 /THAT'S ALL HERE / Z2SM20, TAD ZM0020 /CHECK IF WIDTH < SIXTEEN TAD ZUNIWD SMA CLA JMP Z2SM30 /NO, GO CHECK HEIGHT AC0004 /WIDTH TOO SMALL, DRAW ONLY FOUR DOTS DCA DOTSWD / Z2SM30, TAD ZM0012 /CHECK IF HEIGHT < TEN TAD ZUNIHT SMA CLA JMP Z2SM40 /NO, THAT'S ALL HERE TAD ZK0005 /HEIGHT TOO SMALL, DRAW ONLY FIVE DOTS HIGH DCA DOTSHI / Z2SM40, JMP I Z2SIMP /RETURN PAGE / / --------------------------------- / Z3SIMP - SIMPLIFY CELL ESCAPEMENT / --------------------------------- / Z3SIMP, 0 / /CHECK IF BASELINE ANGLE SPECIFIED TAD ZCELFG /GET THE FLAG SZA CLA /CHECK FOR ZERO JMP ZSIM50 /NOT SPECIFIED, NO NEED TO SIMPLIFY ESCAPEMENT / /SIMPLIFY BASELINE ANGLE FROM DEGREES / TO OCTANT SELECTION DCA ZTEMP /INITIALIZE WORKING QUOTIENT TAD ZBASAN /GET THE BASELINE ANGLE IN DEGREES TAD ZK0026 /OFFSET FOR ROUNDING ZSIM20, TAD ZM0055 /KEEP SUBTRACTING 45. DEGREES SPA / UNTIL ANGLE IS NEGATIVE JMP ZSIM22 ISZ ZTEMP /INCREMENT COUNTER OF 45. DEGREES CHUNKS JMP ZSIM20 /GO BACK TO SUBTRACT SOME MORE / ZSIM22, CLA CLL TAD ZTEMP /GET THE QUOTIENT AND ZK0007 /ENSURE A VALID OCTANT SELECTION DCA ZBASAN /SAVE AS SIMPLFIED BASELINE OCTANT / TAD ZBASAN /GET OCTANT JMS ROTATE /CREATE X ESCAPEMENT XESCTB / FROM 'FORWARD' MOTION ZCELWD / AND CELL WIDTH DCA ZXESC /SAVE X ESCAPEMENT TAD ZBASAN /GET OCTANT JMS ROTATE /CREATE Y ESCAPEMENT YESCTB / FROM 'FORWARD' MOTION ZCELWD / AND CELL WIDTH DCA ZYESC /SAVE Y ESCAPEMENT / ZSIM50, TAD ZPVROT /GET CELL ROTATION JMS ROTATE /CREATE X LINE FEED XLFTAB / FROM 'DOWNWARD' MOTION ZCELHT / AND CELL HEIGHT DCA ZXLFES /SAVE X LINE FEED / TAD ZPVROT /GET CELL ROTATION JMS ROTATE /CREATE Y LINE FEED YLFTAB / FROM 'DOWNWARD' MOTION ZCELHT / AND CELL HEIGHT DCA ZYLFES /SAVE Y LINE FEED / /GET X AND Y COMPONENTS OF / UNIT HEIGHT AND WIDTH TAD ZCELRT /GET OCTANT JMS I XROTAT /CREATE X UNIT WIDTH XESCTB / FROM FORWARD DISPLACEMENT ZUNIWD / AND UNIT WIDTH DCA ZXUNWD /SAVE IT / TAD ZCELRT /GET OCTANT JMS I XROTAT /CREATE X UNIT HEIGHT YESCTB / FROM UPWARD DISPLACEMENT ZUNIHT / AND UNIT HEIGHT CIA /2'S COMPLEMENT (???) DCA ZXUNHT /SAVE IT / TAD ZCELRT /GET OCTANT JMS I XROTAT /CREATE Y UNIT WIDTH YESCTB / FROM 'UPWARD' DISPLACEMENT ZUNIWD / AND UNIT WIDTH DCA ZYUNWD /SAVE IT / TAD ZCELRT /GET OCTANT JMS I XROTAT /CREATE Y UNIT HEIGHT XESCTB / FROM 'FORWARD' DISPLACEMENT ZUNIHT / AND UNIT HEIGHT DCA ZYUNHT /SAVE IT / JMP I Z3SIMP /RETURN / / XESCTB, 1 /X ESCAPEMENT TABLE (MOTION IN X DIRECTION 1 / AS MULTIPLE OF CELL WIDTH) YESCTB, 0 /Y ESCAPEMENT TABLE (OFFSET INTO X TABLE) -1 -1 -1 0 1 1 1 / XLFTAB, 0 /X LINEFEED TABLE (MOTION IN X DIRECTION 1 / AS MULTIPLE OF CELL HEIGHT) YLFTAB, 1 /Y LINEFEED TABLE (OFFSET INTO X TABLE) 1 0 -1 -1 -1 0 1 / ------------------------------------------------ / ROTATE - CREATE A DISPLACEMENT FOR TEXT MOVEMENT / ------------------------------------------------ / / CALL: JMS ROTATE /
/
/ ROTATE, 0 / DCA ROTATM /SAVE OCTANT NUMBER (INDEX INTO TABLE) / TAD I ROTATE /GET ADDRESS OF TABLE DCA ROTAT1 ISZ ROTATE /BUMP POINTER TO NEXT ARGUMENT / TAD I ROTATE /GET ADDRESS OF DISPLACEMENT DCA ROTAT2 ISZ ROTATE /BUMP FOR RETURN ADDRESS / TAD ROTATM /POINT INTO TABLE WITH INDEX TAD ROTAT1 / PLUS TABLE BASE ADDRESS DCA ROTAT3 /SAVE ADDRESS INTO TABLE TAD I ROTAT3 /GET VALUE FROM TABLE SNA /CHECK IF ZERO JMP ROTA20 /IF SO, RESULT IS A ZERO / SPA CLA /CHECK IF POSITIVE JMP ROTA10 /IF NOT, GO USE DISPLACEMENT TIMES (-1) / TAD I ROTAT2 /TABLE VALUE POSITIVE, USE STRAIGHT DISPLACEMENT JMP ROTA20 / ROTA10, TAD I ROTAT2 /NEGATIVE, 2'S COMPLEMENT DISPLACEMENT CIA ROTA20, JMP I ROTATE /RETURN WITH RESULTING DISPLACEMENT / / ROTATM, 0 ROTAT1, 0 ROTAT2, 0 ROTAT3, 0 / ------------------------- / ZDMYSB - DUMMY SUBROUTINE / ------------------------- / ZDMYSB, 0 / CLA CLL JMP I ZDMYSB /DO NOTHING BUT RETURN / / / ------------------------------------- / ZINIT - INITIALIZE CODE IN THIS FIELD / ------------------------------------- / ZINIT, 0 / CLA CLL JMS I XMOVE /COPY DEFAULT PARAMTERS INTO TEXT OPTIONS TXTINI-1 / FROM DEFAULT STORAGE ZCHRST-1 / TO ACTIVE STORAGE ZTXTSZ / THIS MANY WORDS / JMS I XXZCOP /COPY TEXT PARAMS TO MAIN FIELD FOR USE / JMS I XSTXTO /SAVE TEXT OPTIONS / CIF CDF PRGFLD /RETURN TO MAIN FIELD OF PRIMITIVES JMP I ZINIT /RETURN / / XSTXTO, STXTOP XXZCOP, ZCOPYT PAGE / / -------------------------------------------------------- / Z5SIMP - PRECOMPUTE DISPLACEMENTS FOR TEXT PIXEL VECTORS / -------------------------------------------------------- / Z5SIMP, 0 / TAD ZCELRT /GET CELL ROTATION JMS I XROTAT XESCTB ZCELWD DCA ZXCLWD /NOW HAVE X COMPONENT OF CELL WIDTH / TAD ZCELRT JMS I XROTAT YESCTB ZCELHT CIA /COMPLEMENT DCA ZXCLHT /NOW HAVE X COMPONENT OF CELL HEIGHT / TAD ZCELRT JMS I XROTAT YESCTB ZCELWD DCA ZYCLWD /NOW HAVE Y COMPONENT OF CELL WIDTH / TAD ZCELRT JMS I XROTAT XESCTB ZCELHT DCA ZYCLHT /NOW HAVE Y COMPONENT OF CELL HEIGHT / TAD ZYCLWD /BUILD PHYSICAL WIDTH FROM X AND Y COMPONENTS SPA /FORCE ABSOLUTE VALUE CIA CLL RAR TAD ZXCLWD SPA /FORCE ABSOLUTE VALUE CIA DCA ZGDCWD /WIDTH = Y/2 + X / TAD ZYCLHT /BUILD PHYSICAL HEIGHT FROM X AND Y COMPONENTS SPA /FORCE ABSOLUTE VALUE CIA CLL RAR TAD ZXCLHT SPA /FORCE ABSOLUTE VALUE CIA DCA ZGDCHT /HEIGHT = Y/2 + X / / JMP I Z5SIMP /RETURN / ----------------------------------------------- / TXTXPV - CREATE X DISPLACEMENT FOR TEXT PIXEL VECTOR / ----------------------------------------------- / TXTXPV, 0 / DCA ZTEMP /SAVE OCTANT NUMBER / CIF CDF TBLFLD /FORCE TO THIS FIELD / TAD ZTEMP /GET OCTANT NUMBER JMS I XROTAT /CREATE 'FORWARD' CONTRIBUTION XESCTB / FROM 'FORWARD' TABLE ZXPV0 / AND 'FORWARD' DISPLACEMENT DCA TXTXP1 /SAVE THE 'FORWARD' CONTRIBUTION / TAD ZTEMP /GET OCTANT NUMBER JMS I XROTAT /CREATE 'UPWARD' CONTRIBUTION YESCTB / FROM 'UPWARD' TABLE ZXPV2 / AND 'UPWARD' DISPLACEMENT TAD TXTXP1 /ADD THE 'FORWARD' CONTRIBUTION CLL /DIVIDE BY TWO SPA /ENSURE SIGN EXTENDED PROPERLY CML RAR / CIF CDF PRGFLD /SET UP FOR RETURN TO PRIMS MAIN FIELD / JMP I TXTXPV /RETURN WITH X TEXT PV DISPLACEMENT / / TXTXP1, 0 / ----------------------------------------------- / TXTYPV - CREATE Y DISPLACEMENT FOR TEXT PIXEL VECTOR / ----------------------------------------------- / TXTYPV, 0 / DCA ZTEMP /SAVE OCTANT NUMBER / CIF CDF TBLFLD /FORCE TO THIS FIELD / TAD ZTEMP /GET OCTANT NUMBER JMS I XROTAT /CREATE 'FORWARD' CONTRIBUTION XESCTB / FROM 'FORWARD' TABLE ZYPV0 / AND 'FORWARD' DISPLACEMENT DCA TXTYP1 /SAVE THE 'FORWARD' CONTRIBUTION / TAD ZTEMP /GET OCTANT NUMBER JMS I XROTAT /CREATE 'UPWARD' CONTRIBUTION YESCTB / FROM 'UPWARD' TABLE ZYPV2 / AND 'UPWARD' DISPLACEMENT TAD TXTYP1 /ADD THE 'FORWARD' CONTRIBUTION CLL /DIVIDE BY TWO SPA /ENSURE SIGN EXTENDED PROPERLY CML RAR / CIF CDF PRGFLD /SET UP FOR RETURN TO PRIMS MAIN FIELD / JMP I TXTYPV /RETURN WITH X TEXT PV DISPLACEMENT / / TXTYP1, 0 / -------------------------- / STXTOP - SAVE TEXT OPTIONS / -------------------------- / STXTOP, 0 JMS I XMOVE /MOVE MEMORY AROUND ZCHRST-1 / FROM ACTIVE TEXT OPTIONS TXTSAV-1 / TO SAVE BUFFER ZTXTSZ / THIS MANY WORDS / JMP I STXTOP /RETURN / / / -------------------------- / RTXTOP - RESTORE TEXT OPTIONS / -------------------------- / RTXTOP, 0 JMS I XMOVE /MOVE MEMORY AROUND TXTSAV-1 / FROM SAVE BUFFER ZCHRST-1 / TO ACTIVE TEXT OPTIONS ZTXTSZ / THIS MANY WORDS / JMS ZCOPYT /COPY PARAMETERS TO MAIN FIELD / JMP I RTXTOP /RETURN / / / ----------------------------------------- /ZCOPYT - COPY TEXT PARAMETERS TO MAIN FIELD / ----------------------------------------- / ZCOPYT, 0 TAD PZCHRS /POINT TO TEXT PARAMS IN THIS FIELD DCA AUTO17 / TAD PQCHRS /POINT TO TEXT PARAMS IN MAIN FIELD DCA AUTO16 / TAD MTXTSZ /GET COUNT OF WORDS TO MOVE DCA ZTEMP / ZCOPY2, TAD I AUTO17 /GET A WORD FROM HERE CDF PRGFLD /MAIN FIELD DCA I AUTO16 /PUT THE WORD THERE CDF TBLFLD /THIS FIELD ISZ ZTEMP /INCREMENT COUNTER JMP ZCOPY2 / UNTIL EXHAUSTED / JMP I ZCOPYT /RETURN / PZCHRS, ZCHRST-1 PQCHRS, QCHRST-1 MTXTSZ, -TXTSIZ / ------------------ / MOVE - MOVE MEMORY / ------------------ / / CALL: JMS MOVE / / / / MOVE, 0 / CLA CLL TAD I MOVE /GET POINTER TO SOURCE DCA AUTO17 ISZ MOVE / TAD I MOVE /GET POINTER TO DESTINATION DCA AUTO16 ISZ MOVE / TAD I MOVE /GET WORD COUNT CIA /2'S COMPLEMENT FOR LOOP CONTROL DCA ZTEMP ISZ MOVE / MOVE4, TAD I AUTO17 /GET FROM SOURCE DCA I AUTO16 /PUT TO DESTINATION ISZ ZTEMP /INCREMENT COUNTER JMP MOVE4 /LOOP UNTIL COUNTER EXHAUSTED / JMP I MOVE /RETURN PAGE / / ------------------- / TEXT OPTION BUFFERS / ------------------- / /INITIALIZE BUFFER FOR TEXT OPTIONS TXTINI, 0 0 12 11 12 10 0 1 0 11 0 0 24 12 10 12 10 1 2 1 0 0 2 0 10 24 0 11 12 10 22 11 0 0 24 0 11 0 0 24 / / TXTSAV, ZBLOCK ZTXTSZ /SAVE BUFFER FOR TEXT PARAMETERS PAGE / --------------------------------------------- / SAVMOD - SAVE WRITING, NEGATE AND SHADE MODES / --------------------------------------------- / / CALLED FROM MAIN FIELD ONLY / DATA FIELD MUST POINT TO MAIN FIELD AT ENTRY / SAVMOD, 0 / TAD I XWRMOD /SAVE WRITING MODE DCA SAVMTM / TAD I XNEGFL /SAVE NEGATE MODE DCA SAVMT1 / TAD I XSHDFL /SAVE SHADE MODE DCA SAVMT2 / CIF CDF PRGFLD /BACK TO MAIN FIELD JMP I SAVMOD /RETURN / / SAVMTM, 0 SAVMT1, 0 SAVMT2, 0 XWRMOD, WRMODE XNEGFL, NEGFLG XSHDFL, SHDFLG / / / ------------------------------------------------ / RESMOD - RESTORE WRITING, NEGATE AND SHADE MODES / ------------------------------------------------ / RESMOD, 0 / TAD SAVMTM /RESTORE WRITING MODE DCA I XWRMOD / TAD SAVMT1 /RESTORE NEGATE MODE DCA I XNEGFL / TAD SAVMT2 /RESTORE SHADE MODE DCA I XSHDFL / CIF CDF PRGFLD /MAIN FIELD JMP I RESMOD /RETURN PAGE / ------------------------------------------------------------------- / Z4SIMP - PRECOMPUTE X AND Y COMPONENTS OF CHARACTER DOT POSITIONING / ------------------------------------------------------------------- / Z4SIMP, 0 / JMS I XDIVID /X MOTION PER COLUMN = ZXUNWD/DOTSWD ZXUNWD DOTSWD DCA ZXKI /SAVE IT / JMS I XDIVID /Y MOTION PER COLUMN = ZYUNWD/DOTSWD ZYUNWD DOTSWD DCA ZYKI /SAVE IT / JMS I XDIVID /X MOTION PER ROW = ZXUNHT/DOTSHI ZXUNHT DOTSHI DCA ZXKJ /SAVE FOR NOW / JMS I XDIVID /Y MOTION PER ROW = ZYUNHT/DOTSHI ZYUNHT DOTSHI DCA ZYKJ /SAVE FOR NOW / TAD ZXKJ /CALCULATE 2X DOT 'HEIGHT' FOR FIGS D AND D2 SPA / FROM 2(X_HEIGHT)+(Y_HEIGHT) CIA /ENSURE ABSOLUTE VALUE CLL RAL /TIMES TWO DCA ZTEMP /SAVE TWICE X FOR A WHILE TAD ZYKJ /GET Y COMPONENT SPA /ENSURE ABSOLUTE VALUE CIA TAD ZTEMP /COMBINE X AND Y VALUES DCA ZTXTD / AS SOMETHING TO WORK WITH LATER / TAD ZYKI /CALCULATE DOT 'WIDTH' FOR FIGS DC SPA /ENSURE ABSOLUTE VALUE CIA CLL RAR /DIVIDE Y COMPONENT BY TWO (LOG TO PHYS) DCA ZTEMP /SAVE FOR A WHILE TAD ZXKI /GET X COMPONENT SPA CIA TAD ZTEMP /COMBINE WITH Y VALUE DCA ZTXTDC / FOR LATER CONSTRUCTION OF FIGS STRING JMS I XMULTI /X MOTION PER ROW AFFECTED BY ITALICS ZCELIT ZXKI TAD ZXKJ / ADDITIVE COMPONENTS DCA ZXKJ /SAVE REAL VALUE / JMS I XMULTI /Y MOTION PER ROW AFFECTED BY ITALICS ZCELIT ZYKI TAD ZYKJ / ADDITIVE COMPONENTS DCA ZYKJ /SAVE REAL VALUE / JMS I XMULTI /# DOTS THAT FIT IN CELL WIDTH DOTSWD ZCELWD DCA DTWDCL JMS I XUNDIV /UNSIGNED DIVIDE FOR GREATER RANGE DTWDCL ZUNIWD DCA DTWDCL /(CELL WIDTH * # DOTS) / (UNIT WIDTH) / TAD DOTSWD /CHECK IF TOO MANY DOTS CIA TAD DTWDCL SPA CLA JMP Z4SIM2 /NO, USE WHAT WAS CALCULATED TAD DOTSWD /YES, CAN ONLY USE THIS MANY DCA DTWDCL / Z4SIM2, JMS I XMULTI /# DOTS THAT FIT IN CELL HEIGHT DOTSHI ZCELHT DCA DTHTCL JMS I XUNDIV /UNSIGNED DIVIDE FOR GREATER RANGE DTHTCL ZUNIHT DCA DTHTCL /(CELL HEIGHT * # DOTS) / (UNIT HEIGHT) / TAD DOTSHI /CHECK IF TOO MANY DOTS CIA TAD DTHTCL SPA CLA JMP Z4SIM8 /NO, USE WHAT WAS CALCULATED TAD DOTSHI /YES, CAN ONLY USE THIS MANY DCA DTHTCL / Z4SIM8, JMP I Z4SIMP /RETURN / / XMULTI, MULTIP XUNDIV, UNSDIV XDIVID, DIVIDE PAGE / -------------------------------- / DIVIDE - SINGLE PRECISION DIVIDE / -------------------------------- / / CALL: JMS DIVIDE / / / ..RESULT IN AC / / ATTEMPT TO DIVIDE BY ZERO RESULTS IN ZERO. / ALL NUMBERS ARE ASSUMED TO BE 2'S COMPLEMENT NOTATION (-2048 -> +2047) / DIVIDE, 0 / CLA CLL TAD I DIVIDE /GET ADDRESS OF NUMERATOR ISZ DIVIDE /BUMP POINTER TO NEXT ARGUMENT DCA NMRTR TAD I NMRTR /GET NUMERATOR DCA NMRTR /SAVE IT / TAD I DIVIDE /GET ADDRESS OF DENOMINATOR ISZ DIVIDE /BUMP POINTER TO RETURN ADDRESS DCA DNMNTR TAD I DNMNTR /GET DENOMINATOR SNA /CHECK IF ZERO JMP I DIVIDE /CAN'T DIVIDE BY ZERO, RETURN WITH AC=0000 DCA DNMNTR /NON-ZERO, SAVE IT / DCA SIGNFG /ASSUME BOTH VARIABLES POSITIVE / TAD NMRTR /CHECK IF NUMERATOR NEGATIVE SMA JMP DIVID2 /NO CIA /YES, 2'S COMPLEMENT DCA NMRTR /SAVE IT ISZ SIGNFG /MARK SIGN FLAG (LSB) DIVID2, CLA TAD DNMNTR /CHECK IF DENOMINATOR NEGATIVE SMA JMP DIVID4 /NO CIA /YES, 2'S COMPLEMENT DCA DNMNTR /SAVE IT ISZ SIGNFG /MARK SIGN FLAG DIVID4, CLA TAD DNMNTR /GET NEGATIVE DENOMINATOR FOR REPEATED SUBTRACT CIA DCA NDNMNT / DCA QUOTNT /CLEAR QUOTIENT (COUNTER OF SUBTRACTS) / TAD NMRTR /GET NUMERATOR DIVID6, TAD NDNMNT /SUBTRACT DENOMINATOR SPA /CHECK IF TOO MUCH JMP DIVID8 /YES, GO FINISH ISZ QUOTNT /STILL MORE TO GO, INCREMENT QUOTIENT NOP /JUST IN CASE JMP DIVID6 /KEEP SUBTRACTING UNTIL DONE / DIVID8, CLA TAD SIGNFG /CHECK IF WE NEED TO CHANGE SIGN OF RESULT RAR /GET THE IMPORTANT BIT INTO LINK CLA TAD QUOTNT /GET THE RESULT SZL /DO WE HAVE TO COMPLEMENT? CIA /YES (ONLY ONE OF NUM AND DENOM WAS NEGATIVE) JMP I DIVIDE /RETURN WITH RESULT IN AC / / NMRTR, 0 DNMNTR, 0 NDNMNT, 0 QUOTNT, 0 / ----------------------------------- / Z6SIMP - PRECOMPUTE CELL BOUNDARIES / ----------------------------------- / Z6SIMP, 0 / ACNEG1 /GET RELATIVE X_WIDTH OF CHAR TAD ZXCLWD / FROM X_WIDTH TAD ZXCLHT / AND X_HEIGHT SPA /CHECK IF NEGATIVE DIMENSION TAD ZK0002 /IF SO, MUST MOVE TOWARD ZERO DCA DELX /SAVE / AC7776 /GET RELATIVE Y_WIDTH OF CHAR TAD ZYCLWD / FROM Y_WIDTH TAD ZYCLHT / AND Y_HEIGHT SPA /CHECK IF NEGATIVE DIMENSION TAD ZK0004 /IF SO, MUST MOVE TOWARD ZERO DCA DELY /SAVE / TAD ZPVROT /GET CELL ROTATION JMS I XROTAT XESCTB ZCELWD DCA ZXPV0 /NOW HAVE X COMPONENT OF CELL WIDTH / TAD ZPVROT JMS I XROTAT YESCTB ZCELHT CIA /COMPLEMENT DCA ZXPV2 /NOW HAVE X COMPONENT OF CELL HEIGHT / TAD ZPVROT JMS I XROTAT YESCTB ZCELWD DCA ZYPV0 /NOW HAVE Y COMPONENT OF CELL WIDTH / TAD ZPVROT JMS I XROTAT XESCTB ZCELHT DCA ZYPV2 /NOW HAVE Y COMPONENT OF CELL HEIGHT / JMP I Z6SIMP /RETURN PAGE / -------------------------------- / MULTIP - SINGLE PRECISION MULTIP / -------------------------------- / / CALL: JMS MULTIP / / / ..RESULT IN AC / / ALL NUMBERS ARE ASSUMED TO BE 2'S COMPLEMENT NOTATION (-2048 -> +2047) / MULTIP, 0 / CLA CLL TAD I MULTIP /GET ADDRESS OF MULTIPLIER ISZ MULTIP /BUMP POINTER TO NEXT ARGUMENT DCA MLTPLR TAD I MLTPLR /GET MULTIPLIER DCA MLTPLR /SAVE IT / TAD I MULTIP /GET ADDRESS OF MULTIPLICAND ISZ MULTIP /BUMP POINTER TO RETURN ADDRESS DCA MLTPLC TAD I MLTPLC /GET MULTIPLICAND SNA /CHECK IF ZERO JMP I MULTIP /RETURN WITH AC=0000 DCA MLTPLC /NON-ZERO, SAVE IT / DCA SIGNFG /ASSUME BOTH VARIABLES POSITIVE / TAD MLTPLR /CHECK IF MULTIPLIER ZERO SNA JMP I MULTIP /YES, RETURN WITH AC=0000 SMA /CHECK IF MULTIPLIER NEGATIVE JMP MULTP2 /NO CIA /YES, 2'S COMPLEMENT DCA MLTPLR /SAVE IT ISZ SIGNFG /MARK SIGN FLAG (LSB) / MULTP2, CLA TAD MLTPLC /CHECK IF MULTIPLICAND NEGATIVE SMA JMP MULTP4 /NO CIA /YES, 2'S COMPLEMENT DCA MLTPLC /SAVE IT ISZ SIGNFG /MARK SIGN FLAG MULTP4, CLA TAD MLTPLC /GET NEGATIVE MULTIPLICAND FOR REPEATED ADD CIA DCA NMLTPC / MULTP6, TAD MLTPLR /ADD MULTIPLIER ISZ NMLTPC /INCREMENT THROUGH ALL ADDS REQUIRED JMP MULTP6 DCA PRODCT /SAVE RESULT AS PRODUCT / MULTP8, TAD SIGNFG /CHECK IF WE NEED TO CHANGE SIGN OF RESULT RAR /GET THE IMPORTANT BIT INTO LINK CLA TAD PRODCT /GET THE RESULT SZL /DO WE HAVE TO COMPLEMENT? CIA /YES (ONLY ONE OF MULTIPLIERS WAS NEGATIVE) JMP I MULTIP /RETURN WITH RESULT IN AC / / MLTPLR, 0 MLTPLC, 0 NMLTPC, 0 PRODCT, 0 / ------------------------------------------- / BITCMB - COMBINE BITS OF A CHARACTER BITMAP / ------------------------------------------- / BITCMB, 0 / CLA CLL TAD PPCHPT /POINT TO CHARACTER PATTERN DCA AUTO17 / FOR SOURCE TAD PPCHPT /AND AGAIN FOR DESTINATION DCA AUTO16 TAD ZM0012 /GET COUNT OF BYTES DCA ZTEMP / CDF PRGFLD /DATA FROM MAIN PRIM FIELD / BITCM4, TAD ZM0004 /GET COUNT OF RESULTING BITS DCA ZTEMP1 DCA ZTEMP3 /CLEAR STORAGE FOR BIT-COMBINED BYTE TAD I AUTO17 /GET A BYTE DCA ZTEMP2 /SAVE FOR USE HERE / BITCM6, AC0003 /MASK OFF LOW TWO BITS (TWO MAKE ONE) AND ZTEMP2 / OF THE ORIGINAL BYTE CLL /FORCE LINK TO MATCH THE LOW TWO BITS SZA CLA CML TAD ZTEMP3 /GET WORKING RESULT RAR /ROTATE BIT INTO IT DCA ZTEMP3 /SAVE FOR SOME MORE / TAD ZTEMP2 /GET ORIGINAL BYTE (ROTATED) RTR /ROTATE BY TWO DCA ZTEMP2 /SAVE FOR NEXT CHECK / ISZ ZTEMP1 /INCREMENT THROUGH BITS IN RESULT JMP BITCM6 / UNTIL DONE / TAD ZTEMP3 /RIGHT JUSTIFY RESULTING BYTE BSW CLL RTR DCA I AUTO16 /PUT BACK INTO PATTERN / ISZ ZTEMP /INCREMENT THROUGH BYTES JMP BITCM4 / UNTIL DONE / CIF CDF PRGFLD /BACK TO MAIN FIELD / JMP I BITCMB /RETURN / ------------------------------------------- / BYTCMB - COMBINE BYTES OF CHARACTER BIT MAP / ------------------------------------------- / BYTCMB, 0 / CLA CLL TAD PPCHPT /POINT TO CHARACTER BIT MAP DCA AUTO17 / FOR SOURCE TAD PPCHPT /AND AGAIN DCA AUTO16 / FOR DESTINATION TAD ZM0005 /GET COUNTER FOR RESULTING BYTES DCA ZTEMP / CDF PRGFLD /MAIN FIELD OF PRIMS FOR DATA / BYTCM4, TAD I AUTO17 /GET A BYTE MQL /SAVE IN MQ TAD I AUTO17 /GET NEXT BYTE OF PAIR MQA /'OR' WITH PREVIOUS BYTE DCA I AUTO16 /SAVE RESULTING BYTE / ISZ ZTEMP /INCREMENT THROUGH BYTES JMP BYTCM4 / UNITL DONE / CIF CDF PRGFLD /BACK TO PRIM MAIN FIELD / JMP I BYTCMB /RETURN / / PPCHPT, CHRPAT-1 ZTEMP2, 0 ZTEMP3, 0 PAGE / -------------------------------- / UNSDIV - UNSIGNED SINGLE PRECISION DIVIDE / -------------------------------- / / CALL: JMS UNSDIV / / / ..RESULT IN AC / / ATTEMPT TO DIVIDE BY ZERO RESULTS IN ZERO. / ALL NUMBERS ARE ASSUMED TO BE POSITIVE (0000 -> +4095) / UNSDIV, 0 / CLA CLL TAD I UNSDIV /GET ADDRESS OF NUMERATOR ISZ UNSDIV /BUMP POINTER TO NEXT ARGUMENT DCA UNMRTR TAD I UNMRTR /GET NUMERATOR DCA UNMRTR /SAVE IT / TAD I UNSDIV /GET ADDRESS OF DENOMINATOR ISZ UNSDIV /BUMP POINTER TO RETURN ADDRESS DCA UDNMNT TAD I UDNMNT /GET DENOMINATOR SNA /CHECK IF ZERO JMP I UNSDIV /CAN'T UNSDIV BY ZERO, RETURN WITH AC=0000 DCA UDNMNT /NON-ZERO, SAVE IT / CLA TAD UDNMNT /GET NEGATIVE DENOMINATOR FOR REPEATED SUBTRACT CIA DCA UNDNMN / DCA UQUOTN /CLEAR QUOTIENT (COUNTER OF SUBTRACTS) / TAD UNMRTR /GET NUMERATOR SMA /CHECK IF > 2047. JMP UNSDV6 /IF NOT, GO HANDLE LOW RANGE /ELSE, HANDLE HIGH RANGE UNSDV5, TAD UNDNMN /SUBTRACT DENOMINATOR SMA /CHECK IF STILL IN HIGH RANGE JMP UNSDV7 /IF NOT, GO HANDLE LOW RANGE ISZ UQUOTN /MORE TO GO, INCREMENT QUOTIENT NOP /(JUST IN CASE) JMP UNSDV5 /LOOP THROUGH HIGH RANGE / UNSDV6, TAD UNDNMN /SUBTRACT DENOMINATOR SPA /CHECK IF TOO MUCH JMP UNSDV8 /YES, GO FINISH UNSDV7, ISZ UQUOTN /STILL MORE TO GO, INCREMENT QUOTIENT NOP /JUST IN CASE JMP UNSDV6 /KEEP SUBTRACTING UNTIL DONE / UNSDV8, CLA TAD UQUOTN /GET THE RESULT JMP I UNSDIV /RETURN WITH RESULT IN AC / / UNMRTR, 0 UDNMNT, 0 UNDNMN, 0 UQUOTN, 0 PAGE / -------------------------------------------------------------------- / PWRAUX - POWER-ON CLEAR ROUTINE IN AUXILIARY FIELD (NO ROOM IN MAIN) / -------------------------------------------------------------------- / PWRAUX, 0 / TAD K1000 /INTERNAL SYNC GRW1 / AC100 /GET A RESET COMMAND (0400) CLL RTL GRGW /ISSUE IT TO GDC / AC7775 /WAIT ABOUT 40 MS (THREE LOOPS) DCA PWRATM DCA PWRAT1 PWRAU2, ISZ PWRAT1 JMP PWRAU2 ISZ PWRATM JMP PWRAU2 / GRGR /CHECK GDC STATUS AND K0234 /MASK TO BITS THAT COUNT TAD MM0004 /CHECK FOR CORRECT STATUS SNA CLA ACNEG1 /MARK BOARD PRESENT (7777) CDF PRGFLD DCA I XGRFX / OR NOT PRESENT (0000) CDF TBLFLD / PR3 /FIND OUT IF DECMATE II OR III 5001+TBLFLD / BY READING SLUSHWARE'S MEMORY 0021 PWRATM /ROM FIRMWARE ID INTO TEMPORARY -1 7777 / TAD PWRATM /CHECK IF DECMATE II (+) OR III (-) SPA CLA AC1 /MARK DECMATE III (0001) CDF PRGFLD DCA I XDECMA / OR DECMATE II (0000) CDF TBLFLD / GRDR /CHECK IF NEW GRAPHICS BOARD SKP CLA /(A NEW BOARD WILL SKIP) AC1 /MARK AS NEW BOARD (0001) CDF PRGFLD DCA I XGOBTY / OR OLD BOARD (0000) TAD I XGOBTY CDF TBLFLD / SNA CLA JMP PWRAU8 /IF OLD BOARD, WE'RE ALL DONE / JMS R2INIT /INITIALIZE OUTPUT MAP FOR NEW BOARD / PWRAU8, CIF CDF PRGFLD /MAIN FIELD JMP I PWRAUX /RETURN / PWRATM, 0 PWRAT1, 0 K1000, 1000 K0234, 0234 MM0004, -0004 XGRFX, GRFX XDECMA, DECMAT XGOBTY, GOBTYP / -------------------------------------------------------------------- / R2INIT - INITIALIZE OUTPUT MAP FOR NEW STYLE DYNAMIC MAPPED GRAPHICS / -------------------------------------------------------------------- / R2INIT, 0 / CLA CLL CDF PRGFLD /DETERMINE IF GRAPHICS TO MONO TAD I XSETUW / TO SELECT COLOR OR MONO MAP CDF TBLFLD AND ZK0002 /MASK SETUP WORD TO 'GRAPH_TO_MONO' BIT CLL RAR /MAKE A 0000 OR A 0001 TAD PR2TAB /ADD BASE ADDRESS OF TABLE OF TABLE POINTERS DCA R2INTM /SAVE ADDRESS TAD I R2INTM /GET ADDRESS OF MAP TABLE DCA AUTO10 / INTO AUTOINCREMENTING REGISTER / TAD K4100 /POINT REG 1 AT FIRST REG 2 DCA R2INTM TAD M0020 /GET COUNT OF MAP ENTRIES DCA R2INT1 R2INI6, TAD R2INTM /SELECT A MAP INDEX WITH REG 1 GRW1 CLA CLL TAD I AUTO10 /GET ITS VALUE GRW2 / INTO REG 2 CLA CLL ISZ R2INTM /BUMP POINTER THROUGH MAP NOP ISZ R2INT1 /LOOP THROUGH MAP JMP R2INI6 / UNTIL FULL / JMP I R2INIT /RETURN / / K4100, 4100 M0020, -0020 XSETUW, SETUPW R2INTM, 0 R2INT1, 0 PR2TAB, R2TABS R2TABS, R2CTAB-1 R2MTAB-1 / /COLOR MAP R2CTAB, 0000 /DARK BLACK 0012 /DARK GREEN 0240 /DARK RED 0252 /DARK YELLOW 5000 /DARK BLUE 5012 /DARK CYAN 5240 /DARK MAGENTA 3567 /DARK GREY 5252 /BRIGHT GREY 0017 /BRIGHT GREEN 0360 /BRIGHT RED 0377 /BRIGHT YELLOW 7400 /BRIGHT BLUE 7417 /BRIGHT CYAN 7760 /BRIGHT MAGENTA 7777 /BRIGHT WHITE / /MONOCHROME MAP R2MTAB, 0000 2104 1042 3146 0421 2525 1463 3567 4210 6314 5252 7356 4631 6735 5673 7777 PAGE / --------------------------------------------------------- / DM3SET - SET UP FOR NEW STYLE DYNAMIC COLOR MAPPED BOARDS / --------------------------------------------------------- / DM3SET, 0 / RDF /GET CALLING FIELD FOR RETURN TAD ZKCDIF /MAKE A 'CDF CIF' INSTRUCTION DCA DM3ST9 / FOR LATER EXECUTION / TAD I XXSETW /GET USER'S SETUP WORD DCA DM3STM CDF TBLFLD / AC0006 /NEW BOARD, DETERMINE REG 1 VALUE AND DM3STM / FROM USER'S SETUP WORD CLL RAR /ADJUST FOR USE AS TABLE OFFSET TAD PNWBST /ADD BASE ADDRESS OF NEW BOARD SETUP TABLE DCA DM3ST1 /SAVE ADDRESS INTO TABLE TAD I DM3ST1 /GET VALUE FROM TABLE CDF PRGFLD DCA I XREG1H /SAVE AS REGISTER ONE VALUE CDF TBLFLD / AC0002 /CHECK IF 'GRAPHICS TO MONO' SELECTION CHANGED AND DM3STM / BY LOOKING AT LATEST BIT CIA / AND COMPARING TAD SAVGTM / TO PREVIOUS SELECTION SZA JMS I XR2INI /NEW SELECTION, LOAD OUTPUT MAP / AC0002 /SAVE CURRENT 'GRAPHICS TO MONO' SELECTION AND DM3STM DCA SAVGTM / DM3ST9, 0 /BECOMES 'CDF CIF' TO CALLING FIELD JMP I DM3SET /RETURN / / DM3STM, 0 DM3ST1, 0 SAVGTM, 0 /SAVED 'GRAPHICS TO MONO' SELECTION XREG1H, REG1HI ZKCDIF, CDF CIF XXSETW, SETUPW XR2INI, R2INIT / PNWBST, NWBSET /POINTER TO NEW GRAPHICS BOARD REG 1 VALUES NWBSET, 6200 /MONO=TEXT, COLOR=GRAPHICS 7000 /MON0=TEXT+GRAPHICS, COLOR=GRAPHICS 6000 /MONO=TEXT, COLOR=TEXT AND GRAPHICS 6000 /ILLEGAL, ASSUME TEXT TO BOTH MONITORS PAGE / / -------------------------------------------------------------------- / ZTABLE - DISPATCH TABLE FOR PRIMITIVE COMMANDS HANDLED IN THIS FIELD / -------------------------------------------------------------------- / ZTABLE, ZDMYSB /00 ZDMYSB /01 ZDMYSB /02 ZDMYSB /03 ZDMYSB /04 ZDMYSB /05 ZDMYSB /06 ZDMYSB /07 ZDMYSB /08 ZDMYSB /09 ZDMYSB /10 ZDMYSB /11 ZDMYSB /12 ZDMYSB /13 ZDMYSB /14 ZDMYSB /15 ZDMYSB /16 ZDMYSB /17 ZDMYSB /18 ZDMYSB /19 ZDMYSB /20 ZDMYSB /21 ZDMYSB /22 ZDMYSB /23 ZDMYSB /24 ZDMYSB /25 ZDMYSB /26 ZDMYSB /27 ZDMYSB /28 ZDMYSB /29 STXTOP /30 - SAVE TEXT OPTIONS RTXTOP /31 - RESTORE TEXT OPTIONS ZDMYSB /32 ZDMYSB /33 ZDMYSB /34 ZDMYSB /35 ZDMYSB /36 ZDMYSB /37 ZDMYSB /38 ZDMYSB /39 ZDMYSB /40 ZDMYSB /41 TXTSTP /42 - SETUP TEXT PARAMETERS / ------------------------------------------------------------ / DTABLE - DISPATCH TABLE FOR PRIMITIVE COMMANDS IN MAIN FIELD / ------------------------------------------------------------ / DTABLE, PWRUP / ------------- /00 - INITIALIZE HARDWARE (POWER-UP/POWER DOWN) POSTN1 / ------------- /01 - POSITION - MOVE TO SPECIFIED POSITION SVTMPW / ------------- /02 - SAVE WRITE OPTIONS RSTMPW / ------------- /03 - RESTORE WRITE OPTIONS GETVEC / ------------- /04 - VECTOR GTNEGM / ------------- /05 - ENABLE/DISABLE NEGATE MODE SCRNER / ------------- /06 - SCREEN ERASE - FILL CLIP REGION TO COLOR GETDRG / ------------- /07 - SET DISPLAY REGION - CLEAR SCREEN TO BLACK GTBGRD / ------------- /08 - SELECT BACKGROUND COLOR GTFGRD / ------------- /09 - SELECT FOREGROUND COLOR GTWRTM / ------------- /10 - SET WRITING MODE GTLTXT / ------------- /11 - SET LINE TEXTURE GTSHDY / ------------- /12 - SHADE TO Y - ENABLE/DISABLE SHADE CHAR GTSHDO / ------------- /13 - SHADE OFF SCRDMP / ------------- /14 - SCREEN SIXEL DUMP DRWARC / ------------- /15 - CENTER ARC CRVBGN / ------------- /16 - CURVE BEGIN OPEN CRVCLS / ------------- /17 - CURVE BEGIN CLOSED CRVCNT / ------------- /18 - CURVE CONTINUE CRVEND / ------------- /19 - CURVE END GTPLNS / ------------- /20 - GET PLANE SELECT MASK WORD GETTXT / ------------- /21 - DISPLAY CHAR DMYSUB / ------------- /22 - NOP GTCSIZ / ------------- /23 - CLEAR ALPHABET BIT-MAP DMYSUB / ------------- /24 - NOP DMYSUB / ------------- /25 - NOP DMYSUB / ------------- /26 - NOP DMYSUB / ------------- /27 - NOP GTCBMP / ------------- /28 - LOAD CHARACTER INIT / ------------- /29 - INITIALIZE MORCOD / ------------- /30 - SAVE TEXT OPTIONS MORCOD / ------------- /31 - RESTORE TEXT OPTIONS RETPOS / ------------- /32 - REQUEST POSITION TRMNTE / ------------- /33 - TERMINATE SETUP / ------------- /34 - SETUP - CURSOR + GRAPHIC/TEXT SCREEN DMYSUB / ------------- /35 - NOP - NO OPERATION GTLMLT / ------------- /36 - SELECT LINE PATTERN MULTIPLIER RETREG / ------------- /37 - RETURN CO-ORDINATES OF LOGICAL SCREEN GTTXTR / ------------- /38 - GET TEXT REFERENCE POSITION RSTCUR / ------------- /39 - RESTORE CURSOR AFTER TEXT STRING GTXTPV / ------------- /40 - TEXT PIXEL VECTOR MOVEMENT DMYSUB / ------------- /41 - DRAW MARKER EDTBLE, MORCOD / ------------- /42 - TEXT PARAMETER SETUP /************************************************** / FOLLOWING CODE ADDED TO MAKE WPS COMPATIBLE /************************************************** PAGE /ADFB EJECT /ADFB / ADDED FROM VT125 BITMAP TABLE KNOWN AS ALFBIT /THIS TABLE EVENTUALLY STORED IN PANEL MEMORY DURING VT125 CX MODE / / / --------------------------------------------------- / / --------------------------------------------------- / CHARMP - CHARACTER BIT MAPS (7-BY-9 CHARACTER FONT) / --------------------------------------------------- / / TOP / / 00 000 000 / XX XXX XX0 / XX XXX XX0 / XX XXX XX0 / RIGHT XX XXX XX0 LEFT / XX XXX XX0 / XX XXX XX0 / XX XXX XX0 / XX XXX XX0 (DESCENDER) / XX XXX XX0 (DESCENDER) / / BOTTOM / FIELD 2 *0200 CHARMP, 000; 000; 000; 000; 000; 000; 000; 000; 000; 000 /SPACE 000; 020; 020; 020; 020; 020; 000; 020; 000; 000 /EXCLAMATION 000; 000; 110; 110; 110; 000; 000; 000; 000; 000 /DOUBLE QUOTE 000; 044; 044; 176; 044; 176; 044; 044; 000; 000 /NUMBER SIGN 000; 020; 174; 022; 174; 220; 174; 020; 000; 000 /DOLLAR 000; 206; 106; 040; 020; 010; 304; 302; 000; 000 /PER CENTUM 000; 034; 042; 042; 034; 242; 102; 274; 000; 000 /AMPERSAND 000; 060; 020; 010; 000; 000; 000; 000; 000; 000 /APOSTROPHE 000; 040; 020; 010; 010; 010; 020; 040; 000; 000 /LEFT PAREN 000; 010; 020; 040; 040; 040; 020; 010; 000; 000 /RIGHT PAREN 000; 000; 104; 050; 376; 050; 104; 000; 000; 000 /ASTERISK 000; 000; 020; 020; 376; 020; 020; 000; 000; 000 /PLUS 000; 000; 000; 000; 000; 000; 030; 010; 004; 000 /COMMA 000; 000; 000; 000; 376; 000; 000; 000; 000; 000 /MINUS 000; 000; 000; 000; 000; 000; 030; 030; 000; 000 /PERIOD 000; 200; 100; 040; 020; 010; 004; 002; 000; 000 /SLASH 000; 070; 104; 202; 202; 202; 104; 070; 000; 000 /ZERO (0) 000; 020; 030; 024; 020; 020; 020; 174; 000; 000 /ONE (1) 000; 074; 102; 200; 160; 014; 002; 376; 000; 000 /TWO (2) 000; 376; 100; 040; 160; 200; 202; 174; 000; 000 /THREE (3) 000; 040; 060; 050; 044; 376; 040; 040; 000; 000 /FOUR (4) 000; 376; 002; 172; 206; 200; 202; 174; 000; 000 /FIVE (5) 000; 170; 204; 002; 172; 206; 204; 170; 000; 000 /SIX (6) 000; 376; 200; 100; 040; 020; 010; 004; 000; 000 /SEVEN (7) 000; 174; 202; 202; 174; 202; 202; 174; 000; 000 /EIGHT (8) 000; 074; 102; 302; 274; 200; 102; 074; 000; 000 /NINE (9) 000; 000; 030; 030; 000; 000; 030; 030; 000; 000 /COLON 000; 000; 030; 030; 000; 000; 030; 010; 004; 000 /SEMICOLON 000; 200; 040; 010; 002; 010; 040; 200; 000; 000 /LEFT ANGLE 000; 000; 000; 374; 000; 374; 000; 000; 000; 000 /EQUALS 000; 002; 010; 040; 200; 040; 010; 002; 000; 000 /RIGHT ANGLE 000; 174; 202; 140; 020; 020; 000; 020; 000; 000 /QUESTION MARK 000; 374; 202; 242; 222; 162; 002; 002; 174; 000 /COMMERCIAL AT 000; 020; 050; 104; 202; 376; 202; 202; 000; 000 /CAPITAL A 000; 176; 204; 204; 174; 204; 204; 176; 000; 000 /CAPITAL B 000; 170; 204; 002; 002; 002; 204; 170; 000; 000 /CAPITAL C 000; 076; 104; 204; 204; 204; 104; 076; 000; 000 /CAPITAL D 000; 376; 002; 002; 076; 002; 002; 376; 000; 000 /CAPITAL E 000; 376; 002; 002; 076; 002; 002; 002; 000; 000 /CAPITAL F 000; 170; 204; 002; 002; 342; 204; 170; 000; 000 /CAPITAL G 000; 202; 202; 202; 376; 202; 202; 202; 000; 000 /CAPITAL H 000; 174; 020; 020; 020; 020; 020; 174; 000; 000 /CAPITAL I 000; 340; 100; 100; 100; 100; 102; 074; 000; 000 /CAPITAL J 000; 202; 142; 032; 006; 032; 142; 202; 000; 000 /CAPITAL K 000; 002; 002; 002; 002; 002; 002; 376; 000; 000 /CAPITAL L 000; 202; 306; 252; 222; 202; 202; 202; 000; 000 /CAPITAL M 000; 202; 206; 212; 222; 242; 302; 202; 000; 000 /CAPITAL N 000; 174; 202; 202; 202; 202; 202; 174; 000; 000 /CAPITAL O 000; 176; 202; 202; 176; 002; 002; 002; 000; 000 /CAPITAL P 000; 174; 202; 202; 202; 242; 102; 274; 000; 000 /CAPITAL Q 000; 176; 202; 202; 176; 042; 102; 202; 000; 000 /CAPITAL R 000; 174; 202; 002; 174; 200; 202; 174; 000; 000 /CAPITAL S 000; 376; 020; 020; 020; 020; 020; 020; 000; 000 /CAPITAL T 000; 202; 202; 202; 202; 202; 202; 174; 000; 000 /CAPITAL U 000; 202; 202; 104; 104; 050; 050; 020; 000; 000 /CAPITAL V 000; 202; 202; 202; 222; 222; 252; 104; 000; 000 /CAPITAL W 000; 202; 104; 050; 020; 050; 104; 202; 000; 000 /CAPITAL X 000; 202; 104; 050; 020; 020; 020; 020; 000; 000 /CAPITAL Y 000; 376; 100; 040; 020; 010; 004; 376; 000; 000 /CAPITAL Z 000; 170; 010; 010; 010; 010; 010; 170; 000; 000 /LEFT BRACKET 000; 002; 004; 010; 020; 040; 100; 200; 000; 000 /BACKSLASH (\) 000; 074; 040; 040; 040; 040; 040; 074; 000; 000 /RIGHT BRACKET 000; 020; 050; 104; 202; 000; 000; 000; 000; 000 /CARET (^) 000; 000; 000; 000; 000; 000; 000; 000; 376; 000 /UNDERSCORE 000; 030; 020; 040; 000; 000; 000; 000; 000; 000 /ACCENT GRAVE 000; 000; 000; 174; 200; 374; 202; 174; 000; 000 /SMALL A 000; 002; 002; 172; 206; 202; 206; 172; 000; 000 /SMALL B 000; 000; 000; 170; 204; 002; 004; 370; 000; 000 /SMALL C 000; 200; 200; 374; 302; 202; 302; 374; 000; 000 /SMALL D 000; 000; 000; 174; 202; 376; 002; 174; 000; 000 /SMALL E 000; 160; 210; 010; 076; 010; 010; 010; 000; 000 /SMALL F 000; 000; 200; 374; 202; 202; 374; 200; 202; 174 /SMALL G 000; 002; 002; 172; 206; 202; 202; 202; 000; 000 /SMALL H 000; 020; 000; 030; 020; 020; 020; 174; 000; 000 /SMALL I 000; 200; 000; 200; 200; 200; 200; 202; 202; 174 /SMALL J 000; 002; 002; 042; 022; 016; 042; 202; 000; 000 /SMALL K 000; 030; 020; 020; 020; 020; 020; 174; 000; 000 /SMALL L 000; 000; 000; 106; 252; 222; 222; 222; 000; 000 /SMALL M 000; 000; 000; 172; 206; 202; 202; 202; 000; 000 /SMALL N 000; 000; 000; 174; 202; 202; 202; 174; 000; 000 /SMALL O 000; 000; 000; 176; 202; 202; 176; 002; 002; 002 /SMALL P 000; 000; 000; 374; 202; 202; 374; 200; 200; 200 /SMALL Q 000; 000; 000; 162; 214; 004; 004; 004; 000; 000 /SMALL R 000; 000; 000; 174; 002; 174; 200; 174; 000; 000 /SMALL S 000; 010; 010; 076; 010; 010; 110; 060; 000; 000 /SMALL T 000; 000; 000; 102; 102; 102; 102; 274; 000; 000 /SMALL U 000; 000; 000; 202; 202; 104; 050; 020; 000; 000 /SMALL V 000; 000; 000; 202; 202; 222; 252; 104; 000; 000 /SMALL W 000; 000; 000; 102; 044; 030; 044; 102; 000; 000 /SMALL X 000; 000; 000; 202; 202; 302; 274; 200; 202; 174 /SMALL Y 000; 000; 000; 376; 100; 060; 010; 376; 000; 000 /SMALL Z 000; 340; 020; 020; 014; 020; 020; 340; 000; 000 /LEFT BRACE 000; 020; 020; 020; 020; 020; 020; 020; 000; 000 /VERTICAL BAR 000; 016; 020; 020; 140; 020; 020; 016; 000; 000 /RIGHT BRACE 000; 214; 222; 142; 000; 000; 000; 000; 000; 000 /TILDE 377; 377; 377; 377; 377; 377; 377; 377; 377; 377 /ERROR CHARACTER /DECMATE II REGIS INTERPRETER REV= 44 / VERSION 44 - 02 JUL 84 - K HOUSE - FIX LINE PATTERN FROM BINARY STRING. / VERSION 43 - 22 JUN 84 - K HOUSE - IGNORE SCREEN ADDRESS COMMAND UNLESS / BOTH BRACKETED PAIRS GIVEN; / TREAT A MISSING PARAMETER OR A RELATIVE / ZERO AS NO CHANGE IN SCREEN HARDCOPY / OFFSET COMMAND 'S(H(P[X,Y]))'. / VERSION 42 - 21 JUN 84 - K HOUSE - FIX 'GTRUN' SO IT HANDLES AN EMPTY / STRING (HAD MISSED FIRST NON-SPACE / CHARACTER AFTER FIRST QUOTE); / INITIALIZE 'S' PARAMETER AT LOAD TIME / (HAD CAUSED EXPLICIT TEXT SIZING TO FAIL); / FORCE TEXT SIZES > 16 TO SIZE ONE (HAD / FORCED TO SIZE ZERO); / ** VERSION 41 RELEASED WITH V43 FIELD / TEST ** / VERSION 41 - 16 MAY 84 - K HOUSE - FIX CIRCLES AFTER SET SHADE REFERENCE. / VERSION 40 - 09 MAY 84 - K HOUSE - FIX TEXT MULTIPLIER (SHOULDN'T HAVE / BEEN AFFECTED BY SCREEN ADDRESSING). / VERSION 37 - 03 MAY 84 - K HOUSE - EXPAND STACK TO 16 DECIMAL ENTRIES. / VERSION 36 - 25 APR 84 - K HOUSE - FIX TEXT CELL WIDTH SPECIFIER; / SCALE TEXT CELL, UNIT, AND MULTIPLIER / CHANGE DEFAULT COLOR MAP VALUES. /1. FIX TEXT SIZE ROUTINE TO NOT CHANGE TO DEFAULT OF S(1) IF THERE IS A ZERO / PARAMETER IN THE PARAMETERS. /2. DELETE "DCA STKPNT" AT REGI2B+2 TO CORRECT PROBLEM OF SEMICOLON CLEARING / THE POSITION STACK WHEN IT SHOULDN'T. /3. ADD CODE IN LOOKUP ROUTINE TO PREVENT COMMAS FROM PUSHING TO TOP COMMAND / LEVEL. /4. DELETE CODE THAT CALLS INIMAP AT INIT. TIME. ADD A FIXED TABLE AT CMAPTB / WITH VALUES 10 -> 17, 0 -> 7. /DECMATE II REGIS INTERPRETER VER 0.34 2-APR-84 /1. FIX TO SEND PATTERN CALL. /2. ADD COMMA TO TEXT COMMAND OPTION LOOKUP TABLE. /DECMATE II REGIS INTERPRETER VER 0.33 23-MAR-84 /1. ADD NEW ROUTINES TO HANDLE SCREEN HARD COPY COMMANDS ALA VT240 MODE. /2. NEW CODE FOR S(C)"CURSOR ON/OFF". /3. NEW CODE FOR S(T<>) TIMER REQUEST. /4. FIX CODE SO THAT REGIS DOES THE RIGHT THING WHEN GETTING A L"@" -- IT WAS / PREVIOUSLY TRAPPING THE "@" CHAR AS A MACRO-GRAPH INTRODUCER. /5. PUT IN CHANGES TO THE HLSCLB CODE TO MAKE DECGRAPH LOOK BETTER. /DECMATE II REGIS INTERPRETER VER 0.30 29-FEB-84 /1. FIX A BUG IN REGIS WHERE THE PROGRAM WOULD HANG WHEN EXECUTING A MACRO / GRAPH CONTAINING A LOAD TEXT COMMAND. DELETED CODE IN THE CLEANUP ROUTINE, / AND MOVED (2) CONSTANTS OFF OF PAGE 0 AS THEY WERE CONFLICTING WITH PRIMS. /DECMATE II REGIS INTERPRETER VER 0.27 20-FEB-84 /1. FIX "L"OAD CHAR COMMAND TO TERMINATE ON OTHER THAN A SEMICOLON. IT NOW / TERMINATES ON THE FIRST NON-HEX CHARACTER. ****NOTE THAT A "C"IRCLE COMMAND / FOLLOWING A LOAD COMMAND MAY EXPERIENCE PROBLEMS, BECAUSE THE "C" IS VALID / HEX INPUT. /2. DELETE VARIOUS CODE THAT IS NO LONGER USED OR USEFUL. /3. CHANGE TO STORE TEXT (B)EGIN AND RESTORE TEXT (E)ND DATA IN THE REGIS FIELD / INSTEAD OF THE PRIMS. /DECMATE II REGIS INTERPRETER VER 0.25 15-FEB-84 /DECMATE II REGIS INTERPRETER VER 0.24 6-FEB-84 /1. CHANGES TO INCORPORATE THE FIXES TO TEXT COMMAND, WHICH WILL MAKE IT MORE / CLOSELY EMULATE THE VT240. /2. DELETED ADDING 90. TO THE VALUE PASSED BY TEXT ITALIC COMMAND. /3. DELETED CALLS TO THE "SNDESC" ROUTINE. /4. ADDED TEXT COMMAND BLOCK IN PAGE 0. /5. ADDED TABLES TO SUPPORT CHARACTER CELL WIDTH AND HEIGHT. /6. CHANGED THE LOAD CHARACTER ROUTINE TO LOAD 10 BYTES INSTEAD OF 8. /DECMATE II REGIS INTERPRETER VER 0.23 19-JAN-84 /1.MOVE MACROGRAPH CODE INTO TABLE FIELD (5) TO MAKE ROOM FOR NEW CODE TO THE / "TEXT" COMMAND TO REGIS. /DECMATE II REGIS INTERPRETER VER 0.22 13-JAN-84 /1.CHANGE IN CLRTB2 TO PUT "D" AT THE END OF THE TABLE FOR COLOR SELECTION. /DECMATE II REGIS INTERPRETER VER 0.21 15-DEC-83 /1.CHANGED LINE PATTERNS 6 TO 9 TO AGREE WITH THE VT240 IMPLEMENTATION. /2.CHANGED THE WAY S(H) COMMAND IS HANDLED, DOESN'T REQUIRE 2 S(H) COMMANDS NOW. /3.CHANGE IN FL2INT ROUTINE TO CORRECT PROBLEM WHERE CO-ORDS [-1,-1] COULDN'T / BE PASSED TO THE PRIMS. /DECMATE II REGIS INTERPRETER VER 0.20 22-NOV-83 /1.FIXED PROBLEM WITH TEXT COMMAND WHICH WAS NOT RESETING SEMIOK AFTER A QUOTE /ENDING TEXT INPUT. /DECMATE II REGIS INTERPRETER VER 0.17 17-NOV-83 /1.CHANGE AT HLSCLB TO CHECK FOR -41 INSTEAD OF -62 TO FIX COLOR MAP PROBLEM /WITH DECSLIDE. /2.DELETE INITAB. /3.CLEANED UP CODE TO ALWAYS JMP TO LABELS WHEN GOING MORE THAN + OR - 3 WORDS. /DECMATE II REGIS INTERPRETER VER 0.16 15-NOV-83 /1.ADD CODE TO INIT REGIS PROPERLY WHEN ENTERING FROM P1p IN THE MIDST OF A TEXT / OR MACRO-GRAPH COMMAND. /2.ADD CODE TO REQUEST DEVICE PARAMS DURING AN INIT. /3.FIXED PROBLEM WITH REQPOS ROUTINE WHEN IT CONVERTED BETWEEN F.P. -> INTEGER. / /DECMATE II REGIS INTERPRETER VER 0.15 11-NOV-83 / /FIXED HARD COPY FUNCTION TO PRINT ONLY ON SECOND "H" REQUEST. /PARAMETERIZED THE MACRO STORAGE FIELD FOR DEBUG SO THAT THE TERMINAL /EMULATOR WILL WORK PROPERLY. / /DECMATE II REGIS INTERPRETER VER 0.14 10-NOV-83 / /ADDED PIXEL VECTOR MULTPLIER AND CHANGED PV COMMANDS TO USE A PLUSX,MINUSX, /PLUSY, MINUSY RATHER THAN AS IT EXISTED OF ALWAYS ADDING AN PLUS OR MINUS 1. / /REMOVE THE RANGE CHECK ROUTINE BECAUSE IT WAS NOT USED TO MAKE SPACE FOR THE /ABOVE THINGS. / /CHANGED THE FLOATING POINT PACKAGE TO A 3 WORD PACKAGE RATHER THAN /A FOUR WORD PACKAGE. / /DECMATE II REGIS INTERPRETER VER 0.12 2-NOV-83 / 1. INCREASED MACRO GRAPH STORGE TO ALLOW IT TO RUN SPOC PROPERLY /IN ORDER TO DO THIS THE MACRO BUFFER HAD TO BE SHORTENED TO 16 WORDS TO ALLOW /FOR BOTH AN INPUT AND AN OUTPUT BFFER FOR PURGING THE MACRO GRAPH STORAGE. / 2. HLS COLOR MAPPING CODE ADDED. / 3. TABLE ENTRIES MOVED TO FIELD 5. / 4. FIXED A PROBLEM WITH GETCOP WHERE IT WASN'T RETURNING TO THE PROPER / LEVEL WHEN AN ALPHA SPECIFIER WAS USED. / 5. DELETED SOME MORE UNEEDED CODE IN THE FLOATING POINT AREA. / 6. ADDED 'ESCAPE' FLAG TO MARK WHEN ESCAPMENT IS ACTIVE. /DECMATE II REGIS INTERPRETER VER 0.10 26-OCT-83 / / 1. MOVED CODE AROUND TO MAKE PATTERN SPECIFIER FIT. / 2. ADDED PATTERN SPECIFIER TO REGIS. / 3. SCRUNCH MORE CODE. / 4. JMS GETNUM REPLACED BY JMS I XGETNU WHICH RTNS +1 ON ERROR OR +2 ON / VALID INPUT. /DECMATE II REGIS INTERPRETER VER 0.7 25-OCT-83 / 1. ADD CODE TO FIX MACRO-GRAPH PROBLEMS. / 2. DELETE MORE UNNECESSARY CODE TO FREE-UP SPACE FOR EXTRA FUNCTIONS. /DECMATE II REGIS INTERPRETER VER 0.6 21-OCT-83 / 1. DELETED MORE REDUNDENT CODE. / 2. IMPLEMENTED W(F). / 3. CHANGED 5047 TO 5007+RGFLD AND 4074 TO 4070+REGFLD. /DECMATE II REGIS INTERPRETER VER 0.5 21-OCT-83 / 1. ADDED TEXT PIXEL VECTORING. /DECMATE II REGIS INTERPRETER VER 0.4 20-OCT-83 / 1. SHORTENED THE TRANSFER FROM AND TO CP MEMORY. / 2. CORRECTED A PROBLEM IN TEXT AREA IN THAT IS A QUOTE WERE / FOLLOWED BY ANY CHARACTER <40 IT WOULD NOT GET PROCESSED. / ALSO, IF A SEMICOLON WAS THE FIRST CHARACTER AFTER THE QUOTE, / IT WOULD NOT GET DISPLAYED AND RETURN WOULD BE DONE TO MAIN LEVEL. /DECMATE II REGIS INTERPRETER VER 0.3 13-OCT-83 / 1. CRUNCHED THE EQUATES FOR THE PRIMATIVES AND RENAMED TO AGREE WITH / THE NAMING CONVENTIONS USED BY THE PRIMS. /DECMATE II REGIS INTERPRETER VER 0.2 7-OCT-83 / 1. FIX CODE AT SCRADR TO HANDLE NON-PAREN CHARACTER AFTER AN "A". / 2. CHANGE AT GETOP3+4 TO GET CHARACTER FROM LOOK1 INSTEAD OF "CHAR". / 3. CHANGE SHADE COMMAND TO PASS SELECTED CHARACTER, IF ANY, ALONG WITH / THE SHADING REFERENCE LINE. DELETE SHADEC COMMAND (15). / /*************************************************************************** /Basic regis interpretter for the DECmate II /This code is similar to the DECmate II ANSI parser in that it is a /state machine which remains in a particular function until the next /valid sequence is defined. For a more detailed explanation of the functions /supported refer to the ReGIS command summary. / /Entry to this interpretter is done by a JMS 177 to this field with the data /field set to the calling field. The contents of the ac has the following /definition upon entry. / / AC=0 NULL ENTRY. REQUEST FROM TERMINAL EMULATOR / FOR ANY OUTPUT DATA THAT MIGHT BE PENDING. / / AC 101(8)<377(8) GRAPHICS COMMAND TO REGIS / / AC=-1 INITIALIZE THE REGIS INTERPRETTER TO ITS / INITIAL STATE. ALL MACRO GRAPHS ARE CLEARED; / THE CURSOR IS POSTIONED AT HOME (0,0); THE / SELECTED ALPHABET WILL BE 0 (FOR USASCII); TEXT / SIZE WILL BE SET TO 1; DISPLAY REGION WILL / DEFAULT TO THE FULL SCREEN (0,0 TO 799,479); / ALL CURVE FUNCTIONS ARE TERMINATED; ITALIC TO / ZERO IN TEXT; TEXT SPACING FOR TEXT WILL BE 10 / HORIZINTAL WITH A MULTIPLIER OF 1; THE / PERMANENT WRITING OPTIONS WILL BE SET UP AS: / DEFINED BELOW: / / 1. BACKGROUND COLOR WILL BE SET TO BLACK / 2. THE FOREGROUND INTENSITY WILL BE SET TO WHITE; / 3. WRITING MODE WILL BE REPLACE / 4. PIXEL MULTILIER SET TO 1 / 5. NEGATIVE OFF / 6. SHADING OFF / 7. SHADING REFERENCE TO 0,0 (TO X, TO Y TO POINT) / 8. BINARY PATTERN TO 377 (SOLID LINE) / 9. PATTERN MULTIPLIER TO 1 (1 AND 2 ARE SUPPORTED) / 10. PATTERN NUMBER TO 0 FOR SOLID LINE. / 11. AREA TEXTURE (PATTTERN) IS SOLID. / /ALL FLOATING POINT NUMBERS ARE CONVERTED TO INTEGERS WITH NO NORMALIZING DONE. /THE FINAL RESULT IS STORED AS A 36 BIT SIGNED INTEGER AND IS SENT TO THE /TO THE PRIMATIVES IN THE RANGE OF -2048 TO +2047 / R3L= 7014 PR3= 6236 /PRQ 3 DEFINITION /DEBUG=0 /IF IN DEBUG /DFB WPS CHANGE IFDEF DEBUG < MACFLD= 7 /FOR DEBUG ONLY > IFNDEF DEBUG < MACFLD= 4 /FIELD 4 IF THE REAL THING.> MCFLD= MACFLD^10 / REGFLD= 4 /FIELD OF REGIS / PRMFLD= 30 /FIELD OF PRIMATIVES PRIMS=200 /ADDRESS OF PRIMATIVES / RGFLD=REGFLD^10 / TABFLD= 5 /FIELD OF TABLES, BUFFERS AND MACROGRAPH CODE / TBLFLD= TABFLD^10 /FOR CDF STUFF. / TABADD= 200 /STARTING ADDRESS OF TABLES AND BUFFERS. FIELD REGFLD /ESTABLISH *5 /FLOATING POINT ROUTINE POINTERS FPINP= JMS I . FLINTP /FLOATING POINT INPUT ROUTINES /FPOUT= JMS I . / FLOUTP /FLOATING POINT OUTPUT ROUTINES FPINT= JMS I . FPNT /FLOATING POINT INTERPRETTER /EQUATES / DECIMAL PWRUP= 0 /POWER-UP CLEAR POSTN1= 1 /POSTION CURSOR SVTMPW= 2 /SAVE TEMPORARY WRITE OPTIONS RSTMPW= 3 /RESTORE TEMPORARY WRITE OPTIONS GETVEC= 4 /DRAW A VECTOR GTNEGM= 5 /DISABLE/ENABLE NEGATE MODE SCRNER= 6 /SCREEN ERASE - FILL CLIPPING REGION WITH SPEC. COLOR GETDRG= 7 /SET DISPLAY REGION GTBGRD= 8 /SET BACKGROUND COLOR GTFGRD= 9 /SET FOREGROUND COLOR GTWRTM= 10 /SET WRITING MODE GTLTXT= 11 /SET LINE TEXTURE GTSHDY= 12 /SHADING ON GTSHDO= 13 /SHADING OFF SCRDMP= 14 /SCREEN SIXEL DUMP DRWARC= 15 /DRAW A CIRCLE CRVBGN= 16 /CURVE BEGIN OPEN CRVCLS= 17 /CURVE BEGIN CLOSED CRVCNT= 18 /CURVE CONTINUE CRVEND= 19 /CURVE END GTPLNS= 20 /PLANE SELECT MASK WORD GETTXT= 21 /DRAW A GRAPHIC CHARACTER GTCESC= 22 /CHANGE TEXT ESCAPMENT GTCSIZ= 23 /CELL STORAGE SIZE GTCELM= 24 /CELL DISPLAY SIZE GTCROT= 25 /CELL ROTATION ANGLE GTCITL= 26 /CELL ITALIC GTCSET= 27 /SET ALPHABET GTCBMP= 28 /LOAD CHARACTER BITMAP INIT= 29 /POWER UP FROM DEAD SPACE SVTXTO= 30 /SAVE TEXT OPTION RSTXTO= 31 /RESTORE TEXT OPTION RETPOS= 32 /RETURN CO-ORDINATES OF CURSOR POSITION TRMNTE= 33 /TERMINATE GRAPHICS SETUP= 34 /SETUP DMYSUB= 35 /NOT DEFINED GTLMLT= 36 /SET LINE PATTERN MULTIPLIER RETREG= 37 /RETURN LOGICAL SCREEN REGION GTTXTR= 38 /SPECIFY_STARTING_POSTION_OF_TEXT_STRING RSTCUR= 39 /RESTORE CURSOR AT END OF TEXT TPVCMD= 40 /TEXT PIXEL VECTOR COMMAND GTXSET= 42 /TEXT SETUP COMMAND OCTAL *20 CURLEV, 0 RDF TAD KCIF CDF RGFLD DCA I XMAINL /SAVE IN MAINLINE NEXT /EXIT WITH NEXT ENTRY SET UP TO PARSER. NEXT= JMP I . REGRET /EXIT THE CURRENT LEVEL WITHOUT /RESTORING FINI= JMP I . /EXIT BACK TO MAIN LINE INTERPRETTER AS A COMMAND REGIS4 /WAS SEEN AT A TOP LEVEL FUNCTION WHICH COULD /POSSIBLY BE A NEW COMMAND. / /NUMERICAL CONSTANTS / K27, 27 M32, -32 M40, -40 M100, -100 M101, -101 XMAINL, MAINLI KCIF, CIF /ADDRESSES 40-62 ARE RESERVED FOR THE FLOATING POINT PACKAGE / *40 EX1, 0 HIGH1, 0 LOW1, 0 EXP, 0 HORDER, 0 LORDER, 0 OVER2, 0 OVER1, 0 / *62 FLAG, 0 /ARITHMETIC ERROR FLAG / / *63 DIGIT, 0 /STORAGE FOR DIGIT (FP ROUTINES) SIGN, 0 /=0 IF PLUS; = 7777 IF MINUS DNUMBR, 0 /= NUMBER OF DIGITS CURX, ZBLOCK 3 /CURRENT X POSITION(FP NOTATION) CURY, ZBLOCK 3 /CURRENT Y POSITION(FP NOTATION) CURACT, CURVEF, 0 /CURVE FUNCT NOT IN PROGRESS (CURVE TERMINATED) /CURVE ACTIVE FLAG. 0 SAYS NO CURVE IN PROGRESS /AND 3 IF CURVE ACTIVE. (USED TO CALCUALTE PRIM /CALL) / /PERMANENT WRITING OPTIONS / BCOLR, 0 /BACK GROUND COLOR TO BLACK FCOLR, 17 /FORGROUND TO BRIGHT WHITE PMULT, 1; 2000; 0 /CONVERTED TO FLOATING POINT SHADE, 0 /SHADING OFF PATTRN, 377 /BINARY PATTERN (377 BY DEFAULT) PATMUL, 2 /PATTERN MULTIPLIER TO 1 (MAX OF 2) / MLBRKT, -"[+200 /SEVEN BIT CODE FOR "[" MRBRKT, -"]+200 /SEVEN BIT FOR "]" MSEMI, -";+200 /SEVEN BIT FOR ";" MCOMMA, -",+200 /SEVEN BIT FOR "'" MLPREN, -"(+200 /SEVEN BIT FOR "(" MRPREN, -")+200 /SEVEN BIT FOR ")" MSGLQU, -"'+200 /SEVEN BIT FOR "'" MDBLQU, -""+200 /SEVEN BIT FOR '"' /MISC STORAGE ABSFLG, 0 /ABSOLUTE OR RELATIVE FLAG FOR INCOMING NUMERIC /DATA. CIRCUM, 0 /0 SAYS END POINT IS IN THE CENTER /NON-ZERO IS ON THE CIRCUMFERENCE NUMMER, ZBLOCK 3 REPLY, 0 /RESPONSE TO CALLER SEMIOK, 0 /-1 = OK TO PASS SEMICOLON, SPACE, AND CONTROLS /+1 = SEMI'S AND SPACES OK, NO CONTROLS / 0 = NO SEMI'S, SPACES OR CONTROLS TEMP1, 0 TEMP1A, 0 TEMP2, 0 TEMP2A, 0 /HLS CONSTANTS LIGNUM, 0 /LIGHTNESS VALUE SATNUM, 0 /SATURATION HUENUM, 0 /HUE VALUE HLSSEE, 0 /INDICATOR COLSEE, 0 SAVCLR, 0 / XLOOKU, LOOKUP XPRIMS, PRIMS XGETNU, GETNUM XUPPER, UPPER UPPETM, 0 TXTCHR, 0 /FIRST CHARACTER FROM 'GTRUN' TOPBY, 0 TOPBX, 0 / TEXT SETUP PARAMETER BLOCK / TXTBLK, GTXSET /TEXT SETUP COMMAND TDISPL, 0 /DISPLAY ALPHABET TCHRAN, 0 /TEXT CHARACTER ANGLE TCELLH, 24 /TEXT CELL HEIGHT TCELLW, 11 /TEXT CELL WIDTH TUNITH, 24 /TEXT UNIT HEIGHT TUNITW, 10 /TEXT UNIT WIDTH TITLAN, 0 /TEXT ITALIC ANGLE TXFLAG, 0001 /TEXT FLAG FOR BASELINE ANGLE / 0001 = NO CHANGE / 0000 = BASELINE / 7777 = ABSOLUTE ESCAPEMENT TBASES, 0 /TEXT BASELINE OR 'X' ESCAPEMENT TYESCP, 0 /TEXT 'Y' ESCAPEMENT TCHNGE, 0 /TEXT CHANGE FLAG FOR TEXT BEGIN/END LOACTV, 0 /FLAG TO KEEP TRACK OF "@" SIGNS / TEMPO, ZBLOCK 4 / / *176 /*** FIXED ADDRESS **** VERS, REV /COUNT WILL BE IN OCTAL / *177 /BEGINNING OF REGIS REGIS, 0 DCA CHAR /SAVE THE AC AS IT CONTAINS WHAT TO DO DCA REPLY /ENSURE NO REPSONSE RDF /GET THE CALLING DATA FIELD TAD (CIF CDF /MAKE IT A RETURN FIELD DCA REGRT2 /SET UP THE RETURN ADDRESS CIF CDF RGFLD /SET TO REGIS FIELD TAD CHAR /GET THE CURRENT OPERATION SMA CLA /SKIP IF SPECIAL CONTROL CODE JMP REGIS1 /ON TO THE NORMAL REGIS PROCESSING ISZ CHAR /CHECK IF -1(INIT) JMP REGI2B /NO, ASSUME -2 (FORGET MAIN COMMAND) CIF TBLFLD /CHANGE TO FIELD THAT CONTAINS THIS ROUTINE JMS I XCLRGR /AND GO INIT MACRO-GRAPHS // JMS INIMAP /INIT COLOR MAP JMS GTCORD /GET THE PHYSICAL SCREEN COORDINATES. JMS REQPOS /GET CURRENT POSITION DATA DCA LOACTV /INIT LOAD ACTIVE REGRET, CLA CLL TAD REPLY /PASS RESPONSE BACK TO CALLER IN THE AC REGRT2, HLT /MODIFIED TO CIF CDF CALLING FIELD JMP I REGIS /THE AC MAY CONTAIN DATA SO DON'T CLEAR IT OUT REGIS1, TAD CHAR SZA /SKIP IF CHECK FOR OUTPUT JMP REGIS2 /GO PROCESS A REGIS COMMAND JMP REGRET /EXIT WITH PROPER CHARACTER IN THE AC XCLRGR, CLRGRP /POINTER FOR CROSS FIELD CALL / /MAIN LEVEL OF REGIS INTERPRETTER. /AT THIS LEVEL OF PROCESSING THE FOLLOWING COMMANDS ARE LOOKED AT: / P = POSITION COMMAND / V = VECTOR COMMAND / C = CURVE COMMAND / T = TEXT COMMAND / W = PERMANENT WRITING OPTION / S = SCREEN COMMAND / @ = MACROGRAPH COMMAND / R = REPORT COMMAND / L = LOAD CHARACTER COMMAND REGIS2, JMS MAKE7 /CONVERT TO 7 BIT FOR NOW DCA MANTMP /SAVE THE CHARACTER TO PROCESS. REGIAT, TAD LOACTV /SEE IF "LOAD" COMMAND SZA CLA JMP REGI2T JMS CHKMAC /TEST FOR MACRO-GRAPH ARGUMENTS SNA CLA JMP REGIS4 REGI2T, TAD SEMIOK /CHECK IF SEMI TO BE PASSED ON SZA JMP REGI2A /YES, SKIP CHECK TO ABORT TAD MSEMI /TEXT FOR ";" TAD CHAR /GET CHARACTER SZA CLA /SKIP IF IT IS A SEMI JMP REGI2A REGI2B, DCA CURLEV /RETURN TO HIGHEST COMMAND LEVEL DCA CURACT /RESET CURVE ACTIVE // DCA STKPNT /INITIALIZE THE STACK FOR POSITION AND VECTOR JMS CLEANU /GO CLEANUP ANY PENDING TEXT OR MARCO'S JMS RESWOP /RESTORE THE PERMANENT OPTIONS SAVED. IF ANY. NEXT //REGI2E, SPA CLA /POSITIVE MEANS TEXT LOAD IS ACTIVE // JMP REGI2A // JMS CHKMAC /TEST FOR MACRO GRAPH ARGUMENTS // SNA CLA /SKIPS IF NOT A MACRO GRAPH FUNCTION // JMP REGIS4 /GO CLEAR CURRENT LEVEL REGI2A, TAD SEMIOK /ARE SPACES OK? SZA CLA JMP REGI2D /SPACE NOT IGNORED TAD CHAR TAD M40 SNA CLA NEXT /AHA, IGNORE THIS SPACE REGI2D, TAD SEMIOK /ARE CONTROLS OK? SPA CLA JMP REGI2C TAD CHAR /CONTROLS NOT OK TAD M40 SPA CLA NEXT /AHA!, IGNORE THIS CONTROL REGI2C, TAD CURLEV /TEST TO SEE IF A REGIS COMMAND IS IN PROCESS SNA CLA /SKIP IF YES /AND PROCESS ACCORDINGLY. JMP REGIS3 TAD CHAR /GET THE CURRENT CHARACTER MAINLI, HLT JMP I CURLEV /DISPATCH TO CURRENT ACTIVE LEVEL REGIS3, JMS I XLOOKU /DO THE LOOKUP MANTMP, 0 /CHARACTER TO DO MCMD /MAIN COMMAND LINES NEXT /INVALID MAINLINE COMMAND DCA CURLEV /SAVE THE CURRENT LEVEL OF PROCESSING JMS I CURLEV /ESTABLISH RETURN FROM NEXT LOWER LEVEL AND START /THE COMMAND TO PERFORM REGIS4, CLA DCA CURLEV /MARK COMMAND AS COMPLETED. TAD CHAR SNA /SKIP IF COMMAND IS ACTIVE NEXT /NO COMMAND FROM THE PREVIOUS LEVEL THERE JMP REGIS2 /GO BACK AND START NEXT COMMAND CYCLE / /ROUTINE TO CAUSE THE TEMP WRITE OPTIONS TO BE SAVED. / TMPOPT, 0 TAD (SAVOPT /SAVE OPTION BLOCK CIF PRMFLD /CALL THE PRIMATIVES JMS I XPRIMS /CALL THE PRIMATIVES STA DCA WTMOPT /MARK TEMP WRITE OPTIONS AS ACTIVE TAD PMULT /SAVE THE CURRENT PIXEL MULTIPLIER DCA PMULT1 JMS WRITE ISZ TMPOPT /BUMP RETURN OVER ACTION ROUTINE JMP I TMPOPT /EXIT BACK TO CALLER. / /RESTORE THE PERMANENT WRITE OPTIONS / RESWOP, 0 TAD WTMOPT /SEE IF TEMP OPTIONS ACTIVE SNA CLA JMP RESWO1 TAD (RESOPT /RESTORE BLOCK CIF PRMFLD JMS I XPRIMS TAD PMULT1 DCA PMULT /RESTORE THE PIXEL MULTIPLIER RESWO1, DCA WTMOPT /CLEAR INDICATOR JMP I RESWOP RESOPT, RSTMPW /RESTORE TEMP WRITE OPTIONS SAVOPT, SVTMPW /SAVE " " " PMULT1, 0 WTMOPT, 0 DXR, ZBLOCK 3 DYR, ZBLOCK 3 PAGE / /POSITION COMMAND SEEN TO REGIS /ACCEPT THE INCOMING DATA UNTIL A NEW COMMAND IS SEEN AT WHICH POINT A RETURN /TO THE MAIN LEVEL IS DONE TO ACCEPT THE NEW COMMAND. / AC = 0 AT ENTRY / POSIT, 0 POSIT1, JMS CURLEV /ESTABLISH THIS LEVEL OF PROCESSING FOR /NEXT INCOMING CHARACTER. / DCA POSCMD /SAVE IT FOR THE LOOKUP JMS I XLOOKU /EXECUTE A LOOKUP POSCMD, 0 POSTAB /1ST LEVEL OPTION TABLE JMP PCMDER /GO HERE ON ERROR DCA POSCMD /SAVE THE POINTER HERE ON RETURNING JMS I POSCMD /AND DISPATCH TO POINTER ADDRESS / SKP CLA JMS DOPOS /CALL THE PRIMS JMP POSIT1 /GET NEXT CHAR AND RE-ESTABLISH THIS LEVEL / /COMMOM EXIT FOR VECTOR AND POSITION / VCMDER, PCMDER, JMS RESWOP FINI /FOR NOW GO BACK TO MAIN LEVEL / POPT, 0 /COME HERE AFTER FINDING A LEFT PAREN / POPT1, JMS CURLEV / POPT3, DCA POPT2 /SAVE FOR THE LOOKUP JMS I XLOOKU /EXECUTE THE LOOKUP POPT2, 0 POPTBL /2ND LEVEL TABLE FOR POSTION JMP POPT1 /NOT FOUND, GET ANOTHER DCA POPT2 /ELSE SAVE THE POINTER JMS I POPT2 /AND DISPATCH TO POINTER ADDRESS / JMS DOPOS /EXECUTE THE PRIMS / /RETURN HERE ON W,B,E OPTIONS / SNA JMP POPT1 /GET ANOTHER CHARACTER JMP POPT3 / POSITX, 0 JMP I POPT / /DOPOS - EXECUTE THE POSITION COMMAND BY CALLING THE PRIMATIVE PACKAGE / DOPOS, 0 JMS SCAL /GO TO SCALE ROUTINE TAD DXI+2 /GET THE CURRENT X POSTITION DCA MBX /CURRENT X VALUE TAD DYI+2 /Y POSITION DCA MBY CIF PRMFLD TAD (POSBLK /POSITION BLOCK DATA JMS I XPRIMS /TO THE PRIMATIVES JMP I DOPOS / /PBKT - POSITION BRACKET ROUTINE TO HANDLE GETTING AND EXECUTION OF A POSITION / COMMAND. / PBKT, 0 /COME HERE AFTER FINDING A LEFT BRACKET "[" CLA JMS BKTPAR /GET THE NEW POSITION ARGUMENTS POSX /AND SAVE THEM HERE POSY / JMS PVGEN /SEE IF RELATIVE OR ABSOLUTE / ISZ PBKT /BUMP THE RETURN (NEEDED FOR STACK COMMANDS TO / WORK CORRECTLY) JMP I PBKT /AND RETURN POSBLK, POSTN1 /POSITION COMMAND MBX, 0 MBY, 0 VECBLK, GETVEC /VECTOR COMMAND VBX, 0 VBY, 0 / /PVGEN - ROUTINE TO HANDLE GETTING POSITION AND VECTOR NUMERICS / PVGEN, 0 CLA TAD POSX /SEE IF RELATIVE OR ABSOLUTE SNA CLA /SKIP IF RELATIVE JMP GENPX /MOVE NEW VALUE OF X TO PLACE OF USE FPINT /CALL THE FP INTERPRETTER FGET CURX /CURRENT VALUE TO FAC FADD POSX+1 /ADD IT TO EXISTING VALUE FPUT POSX+1 /AND RETURN IT TO NEW VALUES FEXT GENPX, FPINT /CALL THE FP INTERPRETTER FGET POSX+1 FPUT CURX /STORE THE NEW VALUE OF X FEXT /EXIT FLOATING POINT / /NOW SETUP THE NEW VALUE OF Y / TAD POSY /SEE IF RELATIVE OR ABSOLUTE SNA CLA /SKIP IF RELATIVE JMP GENPY /MOVE NEW VALUE OF Y TO PLACE OF USE FPINT /CALL THE FP INTERPRETTER FGET CURY /CURRENT VALUE TO FAC FADD POSY+1 /ADD IT TO THE CURRENT VALUE FPUT POSY+1 /AND RETURN IT TO NEW VALUES FEXT GENPY, FPINT /CALL THE FP INTERPRETTER FGET POSY+1 FPUT CURY /STORE THE NEW VALUE OF Y FEXT /EXIT FLOATING POINT JMP I PVGEN /RETURN / /LPRUN - LEFT PAREN RUN DOWN / COME HERE TO RUN DOWN MATCHING LEFT AND RIGHT PARENS. / / LPRUTM, 0 LPRUN, 0 STA /MARK AS 1 LEFT PAREN DCA LPRUTM /AND SAVE HERE JMS CURLEV /ESTABLISH THIS LEVEL TAD MRPREN /SEE IF IT'S A RIGHT PAREN SZA CLA /SKIP IF IT IS JMP LPRUN5 /ELSE GO HERE ISZ LPRUTM /INCRMENT THE COUNTER NEXT /AND GET ANOTHER CHARACTER JMP I LPRUN /WHEN COUNT = 0 WE'RE DONE LPRUN5, TAD CHAR /GET THE CHARACTER TAD MLPREN /IS IT A LEFT PAREN SZA CLA /SKIP IF YES NEXT /NO, CHECK NEXT CHARACTER STA /ADD -1 TO THE COUNT TAD LPRUTM /ADD TO CURRENT COUNT DCA LPRUTM /SAVE IT NEXT /THEN GET NEXT CHARACTER K360, 11 2640 0 0 / /WOPR - WRITE OPTION REPLACE ROUTINE / WOPR, 0 CLL CLA IAC /MAKE A 1 DCA SETWR+1 /SAVE IT JMS SETWRT /SEND THE CMD TO THE TERM JMP I WOPR / /ROUTINE TO GET UNUSED ARGUMENTS AFTER A "[" / NULBKT, 0 JMS BKTPAR NULLXY NULLXY JMP I NULBKT PAGE / /VECTOR COMMAND SEEN TO REGIS /ACCEPT THE INCOMING DATA UNTIL A NEW COMMAND IS SEEN AT WHICH POINT A RETURN /TO THE MAIN LEVEL IS DONE TO ACCEPT THE NEW COMMAND. / AC = 0 AT ENTRY / VECTOR, 0 VECTO1, JMS CURLEV /ESTABLISH THIS LEVEL OF PROCESSING FOR /NEXT INCOMING CHARACTER. DCA VECCMD /SAVE IT FOR THE LOOKUP JMS I XLOOKU /EXECUTE A LOOKUP VECCMD, 0 VECTAB /1ST LEVEL OPTION TABLE JMP VCMDER /GO HERE ON ERROR DCA VECCMD /SAVE THE POINTER HERE ON RETURNING JMS I VECCMD /AND DISPATCH TO POINTER ADDRESS / SKP CLA JMS DOVEC /CALL THE PRIMS JMP VECTO1 /GET NEXT CHAR AND RE-ESTABLISH THIS LEVEL / /VCMDER MADE A COMMON EXIT WITH PCMDER / VOPT, 0 /COME HERE AFTER FINDING A LEFT PAREN / VOPT1, JMS CURLEV / VOPT3, DCA VOPT2 /SAVE FOR THE LOOKUP JMS I XLOOKU /EXECUTE THE LOOKUP VOPT2, 0 VOPTBL /2ND LEVEL TABLE FOR POSTION JMP VOPT1 /NOT FOUND, GET ANOTHER DCA VOPT2 /ELSE SAVE THE POINTER JMS I VOPT2 /AND DISPATCH TO POINTER ADDRESS / JMS DOVEC /EXECUTE THE PRIMS / /COME HERE ON A W,B, OR S OPTION / SNA JMP VOPT1 /GET ANOTHER CHARACTER JMP VOPT3 / VECTOX, 0 JMP I VOPT / / /CURVE COMMAND SEEN TO REGIS /ACCEPT THE INCOMING DATA UNTIL A NEW COMMAND IS SEEN AT WHICH POINT A RETURN /TO THE MAIN LEVEL IS DONE TO ACCEPT THE NEW COMMAND. / AC = 0 AT ENTRY / CURVE, 0 DCA CIRCUM /INIT THIS FLAG TO ZERO TAD (550 /SET UP CIRCLE DEFAULT ARC VALUE OF 360 DEGREES DCA CIRBLK+3 CURVE1, JMS CURLEV /**ESTABLISH THIS LEVEL OF PROCESSING FOR /NEXT INCOMING CHARACTER. DCA CURCMD /SAVE IT FOR THE LOOKUP JMS I XLOOKU /EXECUTE A LOOKUP CURCMD, 0 CURTAB /1ST LEVEL OPTION TABLE JMP CCMDER /GO HERE ON ERROR DCA CURCMD /SAVE THE POINTER HERE ON RETURNING JMS I CURCMD /AND DISPATCH TO POINTER ADDRESS / JMP CURVE1 /**GET NEXT CHAR AND RE-ESTABLISH THIS LEVEL / CCMDER, DCA CURACT /CLEAR CURVE ACTIVE IN CASE JMS RESWOP /RESTORE TEMP WRITE OPTIONS FINI /GO BACK TO MAIN LEVEL / COPT, 0 /COME HERE AFTER FINDING A LEFT PAREN / COPT1, JMS CURLEV / COPT1A, DCA COPT2 /SAVE FOR THE LOOKUP JMS I XLOOKU /EXECUTE THE LOOKUP COPT2, 0 COPTBL /2ND LEVEL TABLE FOR CURVE JMP COPT1 /NOT FOUND, GO SEE IF A NEW COMMAND DCA COPT2 /ELSE SAVE THE POINTER JMS I COPT2 /AND DISPATCH TO POINTER ADDRESS NOP /REQUIRED - SNA /**SKIP IF SUBOPTION RETURNED FROM PREVIOUS LEVEL JMP COPT1 /GET ANOTHER CHARACTER JMP COPT1A /TRY NEXT SUBOPTION. CURVEX, 0 JMP I COPT /RETURN / /AN OPEN BRACKET WAS SEEN AS THE INTRODUCER. THIS SAYS A CIRCLE IS TO BE /DRAWN WITH A GIVEN CENTER WITH THE EXIT POINT IN THE CENTER. / CURBKT, 0 JMS SAVCUR /SAVE CURRENT POINT AS IT MAY BE USED LATER JMS SCAL /ENSURE PROPER SCALING JMS CIRSET /DO CIRCLE (SETUP CODE) JMS PBKT /ACCEPT A BRACKETED PAIR NOP /NEEDED BECAUSE PBKT NORMALLY RTN'S +2 TAD CURACT /SEE IF A BOUNDED CURVE IS IN PROGRSS SZA CLA /SKIP IF NOT JMP CURBK1 /GO DO SOME SPECIAL STUF FOR THE CURVE TAD CIRCUM /IF ZERO THE CENTER IS SPECIFIED. NEED TO /REPOSITION TO CIRCUMFERENCE SZA CLA /RESTORE TO BEGINNING POINT JMP .+3 JMS DOPOS /DO A POSITION TO GET TO EDGE OF CIRCLE JMP .+3 CURBK1, JMS SCAL JMS CIRSET TAD CURACT /MAKE THE COMMAND FOR THE PRIMATIVES. TAD (DRWARC /NORMAL ARC COMMAND DCA CIRBLK /SAVE IT IN THE COMMAND BLOCK. CIF PRMFLD TAD (CIRBLK /CURVE BLOCK DATA JMS I XPRIMS /TO THE PRIMATIVES TAD CURACT /IF CURVE ACTIVE THEN DON'T RESTORE THE POINT SZA CLA JMP CURBK2 TAD CIRCUM /SEE IF A CIRCLE OR ARC SZA CLA JMP CURBK3 /GO HERE IF AN ARC, ELSE JMS RESCUR /RESTORE CURRENT POINT. JMS DOPOS /AND REPOSITION TO THE CENTER OF THE CIRCLE CURBK2, DCA CIRCUM /CLEAR THE FLAG CURBEX, JMP I CURBKT /EXIT / CURBK3, JMS REQPOS /REQUEST POSITION INFO FROM THE PRIMS JMP CURBEX / /GETNUM - ROUTINE TO GET A NUMERICAL INPUT STREAM / IF NUMERICAL INPUT, EXIT WITH AN INTEGER IN LOCATION "NUMBER" / AND EXIT CALL +2 / IF NO CONVERSION THEN EXIT CALL +1. GETNUM, 0 FPINP /GET DATA TAD DSWIT /ANY CONVERSION ? SNA CLA JMP I GETNUM /NO, TAKE THE ERROR EXIT. FPINT /ELSE, GET THE VALUE FPUT NUMMER /SAVE IT FEXT /EXIT FP JMS FL2INT /CONVERT TO INTEGER NUMMER ISZ GETNUM JMP I GETNUM /RETURN / /SOPT - SCREEN OPTION TIMER / GET THE NUMBER OF CLOCK TICKS / SOPT, 0 JMS I XGETNU /GET THE INPUT JMP SOPTEX /NON-NUMERIC SO EXIT TAD NUMMER+2 /GET THE INTEGER DCA TICKS+1 /SAVE IN CONTROL BLOCK SOPTEX, TAD CHAR /GET THE CHAR THAT TERMINATED INPUT JMP I SOPT /AND RETURN / TICKS, 7776 0 /STORAGE FOR THE TIMER VALUE PAGE / /PIXEL POSITION COMMANDS /THESE ROUTINES ARE ALSO USED IN PROCESSING THE VECTOR COMMAND /PV0 MOVED TO MAKE ROOM FOR PATTERN INPUT. / GETPT4, PV1, 0 JMS MOVEP PLUSX /NEW VALUE OF X MINUSY /NEW VALUE OF Y / JMS PVGEN /GO HERE TO TREAT THE NUMBERS AS RELATIVE / ISZ PV1 JMP I PV1 /EXIT GETPT5, PV2, 0 JMS MOVEP ZERO MINUSY / JMS PVGEN /GO HERE TO TREAT THE NUMBERS AS RELATIVE / ISZ PV2 JMP I PV2 GETPT3, PV3, 0 JMS MOVEP MINUSX MINUSY / JMS PVGEN /GO HERE TO TREAT THE NUMBERS AS RELATIVE / ISZ PV3 JMP I PV3 GETPT1, /USED AS A TEMP FOR PATTERN INPUT PV4, 0 JMS MOVEP MINUSX ZERO / JMS PVGEN /GO HERE TO TREAT THE NUMBERS AS RELATIVE / ISZ PV4 JMP I PV4 GETPT2, /USED AS A TEMP FOR PATTERN INPUT PV5, 0 JMS MOVEP MINUSX PLUSY / JMS PVGEN /GO HERE TO TREAT THE NUMBERS AS RELATIVE / ISZ PV5 JMP I PV5 / /GET PATTERN ROUTINE /INPUTS EITHER A PATTERN BY NUMBER OF BY BINARY VALUE. / GETPAT, 0 TAD PATTRN /SAVE THE CURRENT PATTERN SO IT DOES NOT GET /DESTROYED IN THE PROCESS. DCA GETPT1 GETPTA, DCA GETPT2 /INIT THE CHARACTER COUNTER GETPTB, JMS GETDIG /GET A CHARACTER JMP GETPTC /INVALID CHARACTER DCA GETPT3 /SAVE THE NUMBER. STA /FIRST LOOK FOR 0 OR 1 TAD GETPT3 /ADD BACK IN WHAT WAS RECEIVED SMA SZA CLA /SKIP IF EITHER ZERO OR 1 JMP GETPTD /NOT ZERO OR ONE. MUST BE SOMETHING GREATER. /USE IT AS A PATTERN NUMBER. TAD GETPT2 /GET BACK THE VALUE SNA CLA /SKIP IF NO INIT NEEDED. DCA GETPT1 /INIT THE PATTERN TAD GETPT1 /GET THE CURRENT PATTERN CLL RAL /SETUP TO ADD IN CURRENT BIT PATTERN TAD GETPT3 /CURRENT PATTERN. DCA GETPT1 /AND SAVE IT ISZ GETPT2 /UPDATE THE COUNTER JMP GETPTB /AND TRY ANOTHER. GETPTD, TAD GETPT3 DCA GETPT1 /MAKE THE PATTERN NUMBER CLL CLA IAC /AC=1 TO INDICATE NUMBER OF CHARACTERS ALLOWED. JMP GETPTA /AND SAVE IT AND RTY AGAIN. / /AT THIS POINT A NON-NUMERIC VALUE WAS SEEN. TERMINATE THE FUNCTION AND EXIT. / GETPTC, CLL CLA /BECAUSE THE AC IS GUARENTEED NOT TO BE CLEAR. TAD GETPT2 /FIRST SEE IF ANYTHING WAS SENT IN. SZA CLA /SKIP IF NOT JMP GETPTE /ESTABLISH THE NEW PATTERN TAD PATTRN /JUST RETURN THE PATTERN JMP I GETPAT /AND EXIT. GETPTE, STA /DETERMINE NUMBER OF DIGITS SENT DOWN TAD GETPT2 /IF ONE THEN USE IT AS A PATTERN NUMBER SPECIFOMIER SZA CLA /SKIP IF SPECIFIED BY PATTERN NUMBER. JMP GETPTF /BINARY PATTERN. GO DO THE JUSTIFICATION ON IT TAD GETPT1 /CONTAINS A PATTERN NUMBER RATHER THAN A PATTERN SPA /NEED TO ADJUST IT IF A BINARY 1 CLL CLA IAC /MAKE A 1 TAD (PATTAB-1 /OFFSET INTO PATTERN DCA 10 TAD I 10 JMP I GETPAT /EXIT WITH PATTERN IN THE AC. GETPTF, TAD GETPT2 /TRUNCATE BIT COUNT TO EIGHT TAD (-0010 SMA /NO CHANGE IF LESS THAN EIGHT CLA /FORCE TO EIGHT IF GREATER THAN EIGHT TAD (0010 /RESTORE BIT COUNT DCA GETPT2 / TAD GETPT2 /SHIFT PATTERN TO LEFT JUSTIFY IN 12-BIT WORD TAD (-0014 DCA GETPT3 /NUMBER BITS TO SHIFT = 12. - WHAT WE HAVE / TAD GETPT1 /GET PATTERN AS ENTERED GETPTG, CLL RAL /SHIFT ONE ISZ GETPT3 /LOOP UNTIL LEFT JUSTIFIED JMP GETPTG DCA GETPT1 /SAVE SHIFTED PATTERN / TAD (-0010 /SET UP TO SHIFT EIGHT TIMES TO CREATE REAL DCA GETPT3 / PATTERN (MAY REPEAT ENTERED PATTERN) / DCA GETPT5 /CLEAR 'NEW' PATTERN BEFORE SHIFTING INTO IT / GETPTH, TAD GETPT2 /GET SIZE OF ENTERED PATTERN CIA DCA GETPT6 /FOR LOOP CONTROL / TAD GETPT1 /GET ENTERED PATTERN DCA GETPT4 / AS WORKING SHIFT-OUT PATTERN / GETPTI, TAD GETPT4 /GET WORKING SHIFT-OUT PETTERN CLL RAL /PUT LEFT BIT INTO LINK DCA GETPT4 /SAVE SHIFTED PATTERN TAD GETPT5 /GET WORKING SHIFT-IN PATTERN RAL /SHIFT LINK INTO IT ISZ GETPT3 /CHECK IF DONE EIGHT BITS JMP GETPTJ /NOT YET, KEEP GOING JMP GETPTK /YES, GO RETURN WITH NEW PATTERN GETPTJ, DCA GETPT5 /SAVE WORKING SHIFT-IN PATTERN / ISZ GETPT6 /CHECK IF NEED TO REPEAT ENTERED PATTERN JMP GETPTI /NO, SHIFT WHAT WE HAVE JMP GETPTH /YES, GO REESTABLISH ENTERED PATTERN / GETPTK, JMP I GETPAT /RETURN WITH PATTERN IN AC / / GETPT6, 0 / PAGE / /SOPA - SCREEN ADDRESS ROUTINE /COME HERE FROM A SCREEN ADDRESS COMMAND / SOPA, 0 JMS CURLEV /ESTABLISH THIS LEVEL OF PROCESSING FOR /NEXT INCOMING CHARACTER. TAD MLBRKT /SEE IF IT IS AN OPENING BRACKET "[" SZA CLA /SKIP IF YES JMP SOP1A /INVALID CHARACTER SEEN. RETURN TO PREVIOUS LEVEL JMS BKTPAR /INPUT A BRACKETED PAIR OF DATA TEMPX / INTO TEMPORARY STORAGE TEMPY JMS CURLEV /ESTABLISH THIS LEVEL OF PROCESSING FOR /NEXT INCOMING CHARACTER. TAD MLBRKT /SEE IF IT IS AN OPENING BRACKET "[" SZA CLA /SKIP IF YES JMP SOP1A /ERROR. INVALID CHARACTER IN THE SEQUENCE JMS BKTPAR /INPUT A BRACKETED PAIR OF DATA SCRBX /STORAGE FOR THE PARAMETERS FROM THE INPUT SCRBY / TAD (TEMPX-1 /HAVE BOTH PAIRS, MOVE FIRST TEMP DATA TO REAL DCA 10 TAD (SCRTX-1 DCA 11 TAD (-10 DCA SOPATM SOP2A, TAD I 10 /GET A WORD FROM TEMPORARY DCA I 11 / AND PUT INTO REAL STORAGE ISZ SOPATM /LOOP THROUGH DATA UNTIL DONE JMP SOP2A / /CLEAR OUT THE WORDS AT TX, TY, BX, BY JMS CLTXTY JMS GTCORD /GET THE PHYSICAL COORDINATES JMS SCALER /GO DO THE SCALING CALCULATIONS JMS REQPOS /GET THE CURRENT ABSOLUTE POSITION AND /CONVERT TO THE CURRENT USER COORDINATES / JMS SETCLP /NOW DO THE CLIPPING CALCULATIONS / /SEND THE CLIPPING INFORMATION TO THE PRIMATIVES JMS GENOFF /GO GENERATE THE PV OFFSETS CIF PRMFLD TAD (TSETDR /SET ADDRESS DATA JMS I XPRIMS /TO THE PRIMATIVES JMS DOPOS /REPOSITION TO WHERE THE USER WAS /PREVIOUS TO SCALING. SKP /ALL IS WELL HERE SOP1A, TAD CHAR /RETURN THE CHARACTER. ERROR ON INPUT. JMP I SOPA /EXIT / SOPATM, 0 /LOCAL COUNTER FOR LOOP CONTROL GTCORD, 0 /REQUEST THE PHSICAL PARAMS CIF PRMFLD TAD (RQTBLK JMS I XPRIMS /TO THE PRIMATIVES /SAVE THE INTEGERS RETURNED BY THE PRIMS INTO AREAS USED BY THE SCALER TAD RQTBLK+1 DCA TX+2 TAD RQTBLK+2 DCA TY+2 TAD RQTBLK+3 DCA BX+2 TAD RQTBLK+4 DCA BY+2 /CONVERT TO FLOATING POINT JMS INT2FL TX JMS INT2FL TY JMS INT2FL BX JMS INT2FL BY / JMP I GTCORD / /TOP OF SCREEN / TX, 0 /SCREEN SIZE 0,0 TO 799,479 (THIS WILL REQUIRE /FOUR WORDS OF STORAGE FOR EACH POINT. IT WILL /BE STORED IN FLOATING POINT VALUES AND CONVERTED /TO THE PROPER SCALING COORDINATES. THE DATA IS /STORED IN THE FOLLOWING FORMAT: /WORD 0 = EXPONENT /WORD 1 = HIGH ORDER MANTISSA /WORD 2 = LOW ORDER MANTISSA) 0 /THE INTIAL VALUES MAY CHANGE 0 /X=0 TY, 0 0 0 /Y=0 / /LOWER RIGHT CORNER / BX, 12 /X=799 3076 0 BY, 11 3574 0 /Y=479 / SCRTX, ZBLOCK 4 /REGIS INPUT FOR SCREEN ADDRESS SETUP SCRTY, ZBLOCK 4 /(MUST BE TOGETHER AND IN ORDER) SCRBX, 0; 12; 3076; 0 / = 799 DECIMAL(1437 OCTAL) SCRBY, 0; 11; 3574; 0 / = 479 DECIMAL(737 OCTAL) / TEMPX, ZBLOCK 4 /TEMPORARY STORAGE FOR UPPER LEFT SCREEN ADDRESS TEMPY, ZBLOCK 4 / TSETDR, GETDRG /SET DISPLAY REGION TSETTX, 0 TSETTY, 0 TSETBX, 0 TSETBY, 0 / RQTBLK, RETREG /REQUEST PHYS SCREEN PARAMS 0 /DEFAULT IMPLEMENTATION FOR SCREEN 0 1437 /799 DECIMAL 737 /479 DECIMAL PAGE / /TEXT COMMAND SEEN TO REGIS /ACCEPT THE INCOMING DATA UNTIL A NEW COMMAND IS SEEN, AT WHICH POINT A RETURN /TO THE MAIN LEVEL IS DONE TO ACCEPT THE NEW COMMAND. / / RTEXT, 0 RTEXT1, JMS CURLEV /ESTABLISH THIS LEVEL OF PROCESSING FOR /NEXT INCOMING CHARACTER. RETYP, DCA RTXCMD /SAVE IT FOR THE LOOKUP JMS I XLOOKU /EXECUTE A LOOKUP RTXCMD, 0 TXTTAB /1ST LEVEL OPTION TABLE JMP RTXERR /GO HERE ON ERROR DCA RTXCMD /SAVE THE POINTER HERE ON RETURNING JMS I RTXCMD /AND DISPATCH TO POINTER ADDRESS SNA JMP RTEXT1 /GET NEXT CHAR AND RE-ESTABLISH THIS LEVEL JMP RETYP / RTXERR, JMS RESWOP /RESTORE PERMANENT WRITE OPTIONS SAVEED IF ANY DCA SEMIOK /TERMINATE THE TEXT FUNCTION DCA TYTETM /INIT THE TEXT QUOTE FLAG FINI /GO BACK TO MAIN LEVEL TEXOPT, 0 / TEXOP1, JMS CURLEV TEXOP3, DCA TEXOP2 /SAVE FOR THE LOOKUP JMS I XLOOKU /EXECUTE THE LOOKUP TEXOP2, 0 TOPTBL /2ND LEVEL TABLE FOR TEXT COMMAND JMP TEXOP1 /NOT FOUND, GET ANOTHER CHAR DCA TEXOP2 /ELSE SAVE THE POINTER JMS I TEXOP2 /AND DISPATCH TO POINTER ADDRESS NOP /REQUIRED. SNA /SKIP IF A CHARACTER CAME IN FROM GETNUM JMP TEXOP1 /GET ANOTHER CHARACTER JMP TEXOP3 /TRY ANOTHER CHARACTER TEXOPX, 0 JMP I TEXOPT /RETURN / TYTEXS, 0 /COME HERE FROM A QUOTE CHAR TAD CHAR /GET A CHARACTER CIA /COMPLEMENT DCA TYTETM /SAVE FOR COMPARISON / CIF PRMFLD /ISSUE A CALL TO SET THE STARTING POSITION TAD (SSPBLK JMS I XPRIMS STA DCA SEMIOK /SET FLAG TO ALLOW PRINING OF ";" TYTXS2, STA DCA LOACTV /SET FLAG TO ALLOW PRINING OF ";" JMS CURLEV TAD TYTETM /SEE IF A TERMINATION CHARACTER SNA CLA /SKIP IF NOT JMP TYTXS1 /ELSE GO HERE TO CHECK IT FURTHER JMS TTXT /GO SEND THE CHAR TO SCREEN NEXT /AND THEN GET ANOTHER TYTXS1, DCA LOACTV /KNOCK DOWN FLAG IN CASE A MARCO COMES IN JMS CURLEV TAD TYTETM /IS IT ANOTHER QUOTE? SZA CLA /SKIP IF IT IS AND SEND IT JMP TYEXIT /ELSE EXIT AND GO THRU LOOKUP TABLE AGAIN JMS TTXT /SEND IT TO SCREEN JMP TYTXS2 /AND GO ESTABLISH THIS LEVEL AGAIN AND GET /ANOTHER CHARACTER TYEXIT, JMS RSTPOS /RESTORE CURSOR POSITION DCA SEMIOK /DON'T PASS ON CONTROL,SPACES OR SEMI'S TAD CHAR TAD (-41 /HAVE TO CHECK IN-LINE BECAUSE ALL CHARS WERE SPA CLA /BEING REC'D AT THIS LEVEL SKP /SKIP IF A CONTROL CHARACTER TAD CHAR /ELSE RETURN WITH THE CHAR IN THE AC JMP I TYTEXS /RETURN TYTETM, 0 / /ROUTINE TO RESTORE CURSOR POSITION AFTER A TEXT COMMAND / RSTPOS, 0 CIF PRMFLD TAD (RCURBL JMS I XPRIMS JMS REQPOS JMP I RSTPOS / RCURBL, RSTCUR /RESTORE CURSOR COMMAND BLOCK / /TBKT - COME HERE TO ESTABLISH ESCAPMENT / TBKT, 0 JMS BKTPAR /GET PAIR OF NUMERALS POSX POSY FPINT /CALL THE FLOATING POINT FGET POSX+1 FMPY XFACT FPUT POSX+1 FGET POSY+1 FMPY YFACT FPUT POSY+1 FEXT JMS FL2INT POSX+1 JMS FL2INT POSY+1 TAD POSX+3 /GET NUMERAL DCA TBASES /SAVE TO SEND TO THE PRIMS (X ESCAPMENT) TAD POSY+3 /GET THE Y VALUE DCA TYESCP /SAVE FOR THE PRIMS STA DCA TXFLAG /SET THE TEXT BLOCK ESCAPEMENT FLAG = 7777 JMS DOTXT /SEND IT TO THE PRIMS JMP I TBKT / /SOPH - HARDCOPY COMMAND, SCREEN OPTION H / SOPH, 0 SOPH2, JMS CURLEV /ESTABLISH THIS LEVEL SOPH3, DCA SOPH4 /SAVE FOR THE LOOKUP JMS I XLOOKU /DO THE LOOKUP SOPH4, 0 SHTAB /THE TABLE TO ACCESS JMP SOPH2 /NOT FOUND (MUST BE DONE) DCA SOPH4 JMS I SOPH4 SNA JMP SOPH2 JMP SOPH3 / SOPHEX, 0 SOPH6, TAD (HRDCPY /TELL CALLER THERE IS A HARDCOPY REQUEST DCA REPLY TAD CHAR /GET THE CHAR BACK JMP I SOPH /AND RETURN WITH IT FOR FURTHER PROCESSING PAGE / SOHO, 0 /HERE FROM "S(H(" SOHO2, JMS CURLEV SOHO3, DCA SOHO5 JMS I XLOOKU SOHO5, 0 SOHOPT JMP SOHO2 DCA SOHO5 JMS I SOHO5 SNA JMP SOHO2 JMP SOHO3 SOHOEX, 0 JMP I SOHO / /CURVE CONTROL BLOCK. / CIRBLK, DRWARC /CIRCLE COMMAND 0 /X POSITION 0 /Y POSITION 550 /DRAW AN ARC OF 360 (DECIMAL) DEGREES CURVEC, 0 STA DCA CIRCUM /MARK THE CIRCUMFERENCE AS THE POINT TO END. JMP I CURVEC /AND EXIT / /TTXT - TYPE TEXT PUTS LETTERS ON THE SCREEN / TTXT, 0 CLA TAD CHAR /GET CURRENT CHARACTER DCA TXTCMD+1 /STORE IN CMD BLOCK CIF PRMFLD TAD (TXTCMD /SET ADDRESS DATA JMS I XPRIMS /TO THE PRIMATIVES JMP I TTXT /RETURN / / SSPBLK, GTTXTR /SPEC_STARTING_POSITION_OF_TEXT_STRING COMMAND TXTCMD, GETTXT /TEXT COMMAND 0 /CURRENT CHARACTER TO SEND / /REPORT COMMAND SEEN TO REGIS /ACCEPT THE INCOMING DATA UNTIL A NEW COMMAND IS SEEN AT WHICH POINT A RETURN /TO THE MAIN LEVEL IS DONE TO ACCEPT THE NEW COMMAND. / AC = 0 AT ENTRY / REPORT, 0 REPOR1, JMS CURLEV /ESTABLISH THIS LEVEL OF PROCESSING FOR /NEXT INCOMING CHARACTER. DCA REPCMD /SAVE IT FOR THE LOOKUP JMS I XLOOKU /EXECUTE A LOOKUP REPCMD, 0 REPTAB /1ST LEVEL REPORT OPTION TABLE JMP REPERR /GO HERE ON ERROR DCA REPCMD /SAVE THE POINTER HERE ON RETURNING JMS I REPCMD /AND DISPATCH TO POINTER ADDRESS / JMP REPOR1 /GET NEXT CHAR AND RE-ESTABLISH THIS LEVEL / REPERR, FINI /GO BACK TO MAIN LEVEL REPOPT, 0 /COME HERE TO HANDLE REPORT OPTIONS REPOT1, JMS CURLEV /ESTABLISH THIS LEVEL REPOT3, DCA REPOT2 /SAVE FOR LOOKUP JMS I XLOOKU /EXECUTE THE LOOKUP REPOT2, 0 REPTBL /2ND LEVEL TABLE FOR REPORT JMP REPOT1 /NOT FOUND, GET ANOTHER CHAR DCA REPOT2 /ELSE AAVE THE POINTER JMS I REPOT2 /AND DISPATCH TO THE POINTER ADDRESS SNA /SKIP IF MORE PROCESSING AT THIS LEVEL JMP REPOT1 /NO, GET ANOTHER CHAR JMP REPOT3 /TRY ANOTHER CHARACTER REPEXI, 0 JMP I REPOPT /RETURN / / /WOPS - WRITE OPTION, SHADING ON/OFF / WOPS, 0 DCA SHYBLK+2 /INIT THE SHADE CHAR LOCATION JMS I XGETNU DCA NUMMER+2 /ERROR RETURN JMS SAVCUR /SAVE CURRENT X AND Y TAD CHAR SKP /HAVE A CHARACTER ALREADY WOPS1, JMS CURLEV /ESTABLISH THIS LEVEL AND GET NEXT CHAR WOPS2, DCA WOPS4 /SAVE FOR THE LOOKUP JMS I XLOOKU /DO THE LOOKUP WOPS4, 0 WOPSTB /TABLE TO ACCESS JMP WOPS8 /IF NOT FOUND, FINISH PROCESS DCA WOPS4 /SAVE THE POINTER JMS I WOPS4 /AND DISPATCH TO POINTER ADDRESS SNA /CHECK IF A CHAR ON RETURN JMP WOPS1 /IF NOT, LOOP UNTIL NOT FOUND JMP WOPS2 /IF SO, USE THAT ONE WOPS8, CLA /CHECK IS SHADING REQUESTED TAD NUMMER+2 SNA CLA JMP WOPS9 /NO, GO TURN IT OFF JMS SCAL /ELSE, SCALE TAD DYI+2 DCA SHYBLK+1 /SAVE CIF PRMFLD TAD (SHYBLK JMS I XPRIMS JMP WOPS10 /RETURN TO CALLER WOPS9, CIF PRMFLD TAD (SHOBLK /TURN OFF SHADING JMS I XPRIMS WOPS10, JMS RESCUR /RESTORE CURRENT X AND Y TAD CHAR JMP I WOPS /RETURN TO CALLER WOPSQT, 0 / CLA IAC DCA SEMIOK /NEED TO HANDLE SPACES AT THIS TIME TAD CHAR /GET THE FIRST QUOTE JMS GTRUN /GET THE FIRST CHARACTER IN THE QUOTED STRING CLA /(CLEAR AC, HAS NEXT CHARACTER) DCA SEMIOK /IGNORE SPACES AGAIN TAD TXTCHR /HERE'S THE QUOTED CHARACTER DCA SHYBLK+2 /SAVE IN THE PRIM CONTROL BLOCK / STA /INSURE SHADE WILL BE ON DCA NUMMER+2 TAD CHAR /PASS BACK THE NEXT CHARACTER JMP I WOPSQT / SHOBLK, GTSHDO /SHADE OFF COMMAND SHYBLK, GTSHDY /SHADE ON COMMAND 0 /CURRENT Y POSTION 0 /CURRENT CHARACTER PAGE / /WRITE COMMAND SEEN TO REGIS /ACCEPT THE INCOMING DATA UNTIL A NEW COMMAND IS SEEN AT WHICH POINT A RETURN /TO THE MAIN LEVEL IS DONE TO ACCEPT THE NEW COMMAND. / AC = 0 AT ENTRY / WRITE, 0 WRITEA, JMS CURLEV /ESTABLISH THIS LEVEL OF PROCESSING FOR /NEXT INCOMING CHARACTER. DCA WRTCMD /SAVE IT FOR THE LOOKUP JMS I XLOOKU /EXECUTE A LOOKUP WRTCMD, 0 WRTTAB /1ST LEVEL OPTION TABLE JMP WRTERR /GO HERE ON ERROR DCA WRTCMD /SAVE THE POINTER HERE ON RETURNING JMS I WRTCMD /AND DISPATCH TO POINTER ADDRESS / JMP WRITEA /GET NEXT CHAR AND RE-ESTABLISH THIS LEVEL / WRTERR, TAD CHAR /GO BACK TO MAIN LEVEL WITH CHARACTER IN THE AC JMP I WRITE /BACK TO CALLER. COULD BE FROM TEMP WRITE /OPTIONS WRTOPT, 0 /COME HERE TO HANDLE WRITE OPTIONS WRTOP1, JMS CURLEV / WRTOP3, DCA WRTOP2 JMS I XLOOKU /LOOKUP DESIRED OPTION WRTOP2, 0 WRTTBL /TABLE TO FIND OPTION IN JMP WRTOP1 /NOT FOUND, GET ANOTHER DCA WRTOP2 /SAVE THE ADDRESS JMS I WRTOP2 /AND GO EXECUTE DESIRED OPTION SNA /SKIP IF MORE PROCESSING AT THIS LEVEL JMP WRTOP1 /NO, GET ANOTHER CHAR JMP WRTOP3 /TRY THE CHARACTER FROM PREVIOUS ROUTINE WRITEX, 0 JMP I WRTOPT /RETURN / /SOPE - ERASE ROUTINE /DO A JMS I PRIMS TO ERASE THE SCREEN, THEN /RETURN FROM THE LOOKUP. / SOPE, 0 DCA SHADE /TURN SHADING OFF DCA CURVEF /CLEAR CURVE IN PROGRESS FLAG / DCA STKPNT /THIS, IN EFFECT, CLEARS ANY (B),(S), / OR (E) BLOCKS / CIF PRMFLD TAD (ERASCM /GET THE ERASE COMMAND JMS I XPRIMS /TO THE PRIMATIVES JMP I SOPE /AND JUST RETURN / ERASCM, SCRNER /ERASE COMMAND / PIXEL POSITION COMMANDS / PV6, 0 JMS MOVEP ZERO PLUSY / JMS PVGEN /GO HERE TO TREAT THE NUMBERS AS RELATIVE / ISZ PV6 JMP I PV6 PV7, 0 JMS MOVEP PLUSX PLUSY / JMS PVGEN /GO HERE TO TREAT THE NUMBERS AS RELATIVE / ISZ PV7 JMP I PV7 /MOVEP ROUTINE /THIS ROUTINE WILL STORE THE RESULTS OF CALL +1 INTO POSX /AND CALL+2 INTO POSY AS RELATIVE VALUES / MOVEP, 0 TAD I MOVEP /RELATIVE VALUE OF X DCA MOVEP1 /SAVE IT ISZ MOVEP TAD (POSX /DO X FIRST DCA MOVEP2 TAD (-4 /NUMBER OF WORDS, REL. FLAG + 3 FP DATA WORDS DCA MOVEP3 JMS MOVEP4 /DO THE MOVE TAD I MOVEP /RELATIVE VALUE OF Y DCA MOVEP1 /SAVE IT ISZ MOVEP TAD (POSY /NOW DO Y DCA MOVEP2 TAD (-4 /NUMBER OF WORDS DCA MOVEP3 JMS MOVEP4 /DO THE MOVE JMP I MOVEP /EXIT MOVEP1, 0 MOVEP2, 0 MOVEP3, 0 MOVEP4, 0 MOVP4A, TAD I MOVEP1 DCA I MOVEP2 ISZ MOVEP1 ISZ MOVEP2 ISZ MOVEP3 JMP MOVP4A JMP I MOVEP4 / /TOPI - TEXT OPTION ITALIC / TOPI, 0 JMS I XGETNU /GET A DECIMAL NUMBER JMP TOPIA /NOT A NUMERIC VALUE TAD NUMMER+2 /GET THE 12 BIT INTEGER DCA TITLAN /SAVE IT HERE FOR COMMAND BLK JMS DOTXT /SEND IT TO THE PRIMS / JMS SNDESC TOPIA, TAD CHAR /GET CHARACTER WHICH TERMINATED THE INPUT JMP I TOPI /RETURN / SCROPT, 0 /COME HERE AFTER FINDING A LEFT PAREN / SCROP1, JMS CURLEV / SCROP3, DCA SCROP2 /SAVE FOR THE LOOKUP JMS I XLOOKU /EXECUTE THE LOOKUP SCROP2, 0 SOPTBL /2ND LEVEL TABLE FOR SCREEN ADDR COMMAND JMP SCROP1 /NOT FOUND, GET ANOTHER DCA SCROP2 /ELSE SAVE THE POINTER JMS I SCROP2 /AND DISPATCH TO POINTER ADDRESS SNA /SKIP IF MORE TO COME JMP SCROP1 /NO, GET ANOTHER CHAR JMP SCROP3 SCREEX, 0 JMP I SCROPT /RETURN ZERO, -1; 0; 0 ;0 / /SOPC - SCREEN OPTION "C" - CURSOR ON/OFF / ANY NON-ZERO NUMBER WILL TURN ON THE GRAPHICS CURSOR / SOPC, 0 JMS I XGETNU /GET INPUT JMP SOPCEX /NOT A VALID NUMBER, SO EXIT TAD NUMMER+2 /GET THE NUMMER DCA CURSOR+1 /SAVE IT IN THE CURSOR CONTROL BLOCK TAD (CURSOR DCA REPLY SOPCEX, TAD CHAR /GET THE LAST CHAR JMP I SOPC /AND RETURN WITH IT CURSOR, 7774 /TELLS THE VT125 MODULE THIS IS A CURSOR CMD 0 /STORAGE FOR THE ARGUMENT PAGE / /INPUT A BRACKETED PAIR OF COORDINATES. /ENTER THE ROUTINE WITH: / CALL +1 = X POSITION BUFFER / CALL +2 = Y POSITION BUFFER / /ALL INPUT IS DONE IN FOUR WORD FLOATING POINT. / /THE STRUCTURE OF BOTH THE X AND THE Y BUFFER ARE AS FOLLOWS: / WORD 0 = ABSLOLUTE FLAG INDICATOR. THIS IS USED TO DETERMINE IF A SIGN / PRECEDED THE CHARACTER. IF A SIGN IS IN FRONT OF THE STREAM / THEN THE DATA IS ASSUMED TO BE RELATIVE AND IS ADDED TO THE / EXISTING VALUE. IF THERE IS NO SIGN THEN THE VALUE IS TAKEN / AS ABSOLUTE. (-1 IN THE WORD INDICATES RELATIVE. 0 INDICATES / ABSOLUTE.) / WORD 1 = EXPONENT / WORD 2 = HIGH ORDER MANTISSA / WORD 3 = MID ORDER MANTISSA / WORD 4 = LOW ORDER MANTISSA / /EXIT IS MADE TO THE USER WITH THE APPROPRIATE VALUES SET. / /THE FOLLOWING TESTS ARE PERFORMED AND RESULTS RETURNED AS DESCRIBED BELOW: / / FORMAT [] RETURNS 0 FOR X AND Y WITH BOTH FLAGS SET TO RELATIVE. / THIS IS A NULL PARAMETER. / FORMAT [X,Y] RETURNS THE VALUES OF X AND Y WITH THE INDICATOR SET / TO ZERO FOR ABSOLUTE ADDRESSING / FORMAT [X] RETURNS X WITH THE FLAG SET TO ABSLOUTE AND Y SET TO / ZERO AND THE FLAG TO -1 FOR RELATIVE ADDESSING / FORMAT [,Y] RETURNS X EQUAL TO ZERO AND THE FLAG SET TO -1 FOR / RELATIVE AND Y SET TO VALUE WITH THE FLAG SET TO ZERO / FOR ABSOLUTE ADDRESSING. / FORMAT [+-X] RETURNS X WITH THE FLAG SET TO -1 FOR RELATIVE AND Y / EQUAL TO ZERO WITH FLAG EQUAL TO -1 FOR RELATIVE. / FORMAT [,+-Y] RETURNS X EQUAL TO ZERO WITH THE FLAG SET TO -1 FOR / RELATIVE AND THE VALUE OF Y WITH FLAG EQUAL TO -1 / FOR RELATIVE. / FORMAT [X,+-Y] RETURNS THE VALUE OF X WITH THE FLAG EQUAL TO ZERO FOR / ABSOLUTE AND THE VALUE OF Y WITH THE FLAG EQUAL TO -1 / FOR RELATIVE ADDRESSING / FORMAT [+-X,Y] RETURNS THE VALUE OF X WITH THE FLAG EQUAL TO -1 FOR / RELATIVE AND THE VALUE OF Y WITH THE FLAG EQUAL TO ZERO / FOR ABSOLUTE VALUE. / FORMAT [+-X,+-Y]RETURNS THE VALUE OF X WITH THE FLAG EQUAL TO -1 FOR / RELATIVE AND THE VALUE OF Y WITH THE FLAG EQUAL TO -1 / FOR RELATIVE. / BKT1, 0 BKT2, 0 BKTPAR, 0 /INPUT A BRACKETED PAIR TAD I BKTPAR /GET X VALUE POINTERS DCA BKT1 ISZ BKTPAR TAD I BKTPAR /AND THE Y VALUES ISZ BKTPAR DCA BKT2 /AND SAVE IT AS WELL DCA ABSFLG /CLEAR SIGN INDICATOR FOR X FUNCTION FPINP /GET DATA TAD CHAR /GET BACK THE CHARACTER TAD MRBRKT /SEE IF CLOSING SQUARE BRACKET SZA CLA /SKIP IF YES (NO ARGUMENTS TO IT) JMP GETX2 /ERROR IN COMMAND. TRY LOOKING FOR A COMMA /AND THEN TRY TO RESYNC THE ROUTINE TAD DSWIT /SEE IF CONVERSION WAS PERFORMED (WILL BE ZERO IF NOT) SNA CLA /SKIP IF NO JMP GETX1 /NO DIGIT INPUT. MARK BOTH AS ZERO FOR RESYNCH TAD ABSFLG /MAINTAIN RELATIVE/ABSOLUTE FLAG DCA I BKT1 ISZ BKT1 STA DCA I BKT2 ISZ BKT2 /MARK THE Y AS RELATIVE FPINT /NOW GET THE VALUE RETRIEVED FROM INPUT FPUT I BKT1 /STORE THE NEW VALUE OF X FGET ZERO+1 FPUT I BKT2 /MAKE SURE Y POINTER IS ZEROED FEXT JMP I BKTPAR /AND EXIT GETX1, STA /MARK THE FLAG AS RELATIVE FOR NOW DCA I BKT1 STA DCA I BKT2 /AS WELL AS THE Y VALUE / /NOW GET THE VALUE (SHOULD BE ZERO) / DCA EXP /CLEAR OUT FLOATING POINT DCA HORDER DCA LORDER ISZ BKT1 /POINT TO FLOATING POINT STORAGE AREA ISZ BKT2 FPINT /GET THE VALUE FPUT I BKT1 /NOW POINTS TO BUFFER AREA FOR VALUES FPUT I BKT2 FEXT /ALL DONE JMP I BKTPAR /AND EXIT THE ROUTINE GETX2, TAD MCOMMA /SEE IF IT IS A COMMA TAD CHAR /AND THE CHARACTER SNA CLA /SKIP IF NOT. (ERROR IN COMMAND STREAM) JMP GETY /NOW GO GET THE Y VALUE JMS GETERR JMP GETX1 GETY, TAD DSWIT /SEE IF CONVERSION WAS PERFORMED (WILL BE ZERO IF NOT) SZA CLA /SKIP IF NO JMP GETY1 /MAINTAIN VALUE OF ABSOLUTE/RELATIVE FLAG STA /ESTABLISH RELATIVE POINTER DCA ABSFLG /MARK ABSOLUTE INDICATOR FOR RELATIVE GETY1, TAD ABSFLG /GET THE VALUE OF THE RELATIVE/ABSOLUTE INDICATOR DCA I BKT1 /MARK AS RELATIVE DCA ABSFLG ISZ BKT1 /POINT TO STORAGE AREA FPINT /CALL THE FP INTERPRETTER FPUT I BKT1 /STORE THE DATA OF ZERO FEXT /EXIT COMMAND FPINP /GET THE NEW VALUES TAD CHAR /FIRST LETS SEE IF CHARACTER WAS THE PROPER TERMINATOR TAD MRBRKT /RIGHT SQUARE BRACKET SNA CLA /SKIP IF NOT JMP GETY1A STA /SET THE X POINTER TO PROPER VALUE TAD BKT1 DCA BKT1 /AND SAVE IT AGAIN JMS GETERR /ERROR IN COMMAND STRING JMP GETX1 /TAKE ERROR EXIT GETY1A, TAD DSWIT /SEE IF ANY CONVERSIONS DONE SZA CLA /SKIP IF YES JMP GETY2 STA DCA ABSFLG /MARK THE ABSOLUTE/RELATIVE INDICATOR PROPERLY GETY2, TAD ABSFLG /GET THE VALUE OF THE RELATIVE/ABSOLUTE INDICATOR DCA I BKT2 /MARK AS RELATIVE ISZ BKT2 /POINT TO STORAGE AREA FPINT /CALL THE FP INTERPRETTER FPUT I BKT2 /STORE THE DATA OF ZERO FEXT /EXIT COMMAND JMP I BKTPAR /BRACKETTED PAIR SHOULD HAVE BEEN DONE GETERR, 0 JMS CURLEV /SET UP NEXT ENTRY POINT TO PARSER TAD MRBRKT /RIGHT BRACKET SZA CLA /SKIP IF NOT NEXT JMP I GETERR / /WOPC - WRITE OPTION COMPLEMENT ROUTINE / WOPC, 0 CLA CLL IAC RAL / AC = 2 DCA SETWR+1 /SAVE IT JMS SETWRT /SEND THE CMD TO THE TERM JMP I WOPC /RETURN TO HIGHER LEVEL / /WOPE - WRITE OPTION ERASE ROUTINE / WOPE, 0 CLA CLL IAC CML RAL /AC = 3 DCA SETWR+1 /SAVE IT JMS SETWRT /SEND THE CMD TO THE TERM JMP I WOPE / /WOPV - WRITE OPTION OVERLAY ROUTINE / WOPV, 0 CLA DCA SETWR+1 /SAVE IT JMS SETWRT /SEND THE CMD TO THE TERM JMP I WOPV / /TOPD - TEXT OPTION "D" - CELL ROTATION / TOPD, 0 JMS I XGETNU /GET A DECIMAL NUMBER JMP TOPDA /INVALID RESPONSE TAD NUMMER+2 /GET THE INTEGER DCA TCHRAN /SAVE IN COMMAND BLK JMS DOTXT /SEND IT TO THE PRIMS / JMS SNDESC /SEND THE STORED ESCAPEMENT IF NECESSARY TOPDA, TAD CHAR /GET CHARACTER WHICH TERMINATED THE INPUT JMP I TOPD /RETURN NULLXY, ZBLOCK 4 PAGE / /SOPI - SET BACKGROUND COLOR OPERATION /COME HERE TO CHANGE BACKGROUND COLOR WHEN SELECTED BY AN S(I) COMMAND / SEBCLR, GTBGRD /SET BACKGROUND COLOR COMMAND BCLR, 0 /CONTAINS THE DESIRED COLOR / / /RETURN HERE SAYS ANOTHER CHARACTER HAS TO BE PROCESSED / SOPI1A, TAD CHAR /GET CHARACTER WHICH TERMINATED THE INPUT JMP I SOPI /EXIT BACK TO CALLER SOPI, 0 JMS GETCLR /GET THE COLOR JMP SOPI1A /ERROR IN SPECIFIER. EXIT WITH CURRENT CHARACTER /IN THE AC. CLA TAD SAVCLR /GET DESIRED COLOR DCA BCOLR /AND SAVE IT FOR LATER USE TAD SAVCLR DCA BCLR /SAVE FOR THE BACKGROUND COMMAND / CIF PRMFLD TAD (SEBCLR /POINTS TO THE COMMAND JMS I XPRIMS /SEND IT TO THE PRIMS JMP SOPI1A /RETURN TO HIGHER LEVEL / / /WOPI - SET FOREGROUND COLOR OPERATION /COME HERE TO CHANGE FOREGROUND COLOR WHEN SELECTED BY A W(I) COMMAND / SEFCLR, GTFGRD /SET FOREGROUND COLOR COMMAND FCLR, 0 /CONTAINS THE DESIRED COLOR / /ENTRY HERE SAYS AN INVALID CHARACTER WAS SEEN AT THIS LEVEL. RETURN TO HIGH /LEVEL FOR PROCESSING / WOPI, 0 JMS GETCLR JMP WOPIA /ERROR EXIT. INVALID SELECTION IN COLOR VALUES /GO BACK TO PREVIOUS LEVEL AND DO ANOTHER OPTION CLA TAD SAVCLR /GET DESIRED COLOR DCA FCOLR /AND SAVE IT FOR LATER USE TAD SAVCLR DCA FCLR /SAVE FOR THE BACKGROUND COMMAND / CIF PRMFLD TAD (SEFCLR /POINTS TO THE COMMAND JMS I XPRIMS /SEND IT TO THE PRIMS WOPIA, TAD CHAR /RETURN CHARACTER IN THE AC JMP I WOPI / /SETWRT - SENDS THE WRITE OPTION CONTAINED IN LOC SETWR+1 TO THE PRIMS / SETWRT, 0 CIF PRMFLD TAD (SETWR /SEND TO THE PRIMS JMS I XPRIMS JMP I SETWRT SETWR, GTWRTM 0 /LOCATION FOR BUILDING OPTION WORD / /ROUTINE TO INPUT A FOREGROUND OR BACKGROUND COLOR FOR THE WRITING OPTIONS. /RETURN IS MADE CALL +1 IF AN INVALID SELECTION; CALL+2 IF VALID. /STAY IN THIS ROUTINE UNTIL AN INVALID SELECTION IS SEEN. / GETCLR, 0 STA DCA SAVCLR /MARK THE COLOR AS INVALID FOR RETURN CODE. JMS I XGETNU /GO TO INPUT ROUTINE JMP GETCL3 /INVALID ARGUMENT. NON-NUMERIC. TAD NUMMER+2 /GET THE NUMBER BACK AND (17 /MASK TO A VALID COLOR. TAD (CMAPTB /BASE OFFSET TO COLOR MAP DCA SAVCLR /SAVE THE COLOR SELECTED. CDF TBLFLD /TABLE FIELD TAD I SAVCLR /GET THE REAL COLOR VALUE CDF RGFLD /BACK TO HOME FIELD DCA SAVCLR /AND SAVE IT FOR LATER USEAGE JMP EXBCLR /GO SEND THE COMMAND TO THE PRIMS /COME HERE TO SEE IF CHAR IS ONE OF DESIGNATED ALPHA COLOR SPECIFIERS /OR AN HLS DESCRIPTOR GETCL3, TAD CHAR DCA GETCL4 /SAVE FOR LOOKUP JMS I XLOOKU /DO THE LOOKUP GETCL4, 0 CLRTB1 /PROCESS COLOR BY LETTER VALUE JMP I GETCLR /ERROR, GO BACK TO HIGHER LEVEL AND PROCESS DCA GETCL4 JMS I GETCL4 EXBCLR, TAD SAVCLR /SEE IF A VALID COLOR WAS SPECIFIED. SPA CLA /SKIP IF YES JMP I GETCLR /ERROR EXIT ISZ GETCLR /UPDATE TO VALID RETURN JMP I GETCLR /AND EXIT / /SUBOPTION ROUTINE. AN OPEN PARENS WAS SEEN. NOW START LOOKING FOR VALID COLOR /VALUES AS CHARACTERS OR AS HLS RATHER THAN NUMBERS. / GETCOP, 0 /GET COLOR BY LETTER UNTIL A CLOSE PAREN IS SEEN TAD (62 /SET UP HLS DEFAULTS DCA LIGNUM /L=50% TAD (144 DCA SATNUM /SATURATION TO 100% TAD (360 DCA HUENUM /HUE TO 240 STA DCA HLSSEE /NO HLS SET STA / DCA COLSEE /NO COLOR SET GETCOA, JMS CURLEV /ESTABLISH THIS LEVEL OF PROCESSING. GETCOB, DCA GETOP1 /SAVE THE CHARACTER FOR THE LOOKUP JMS I XLOOKU /SEE IF CLOSING PARENS (LOOKUP WILL RUN DOWN ANY /THING THAT IS NOT VALID GETOP1, 0 CLRTB3 JMP GETOP2 /NOT A CLOSE PAREN. SEE IF IT IS A VALID COLOR DCA GETOP1 /SAVE THE ROUTINE ADDRESS JMS I GETOP1 /EXECUTE THE ROUTINE SZA JMP GETCOB JMP GETCOA GETOP2, DCA GETOP1 /INIT THE COUNTER. TAD (CLRTB2-1 /OPTION TABLE DCA 10 SKP GETOP3, ISZ GETOP1 /UPDATE THE COLOR INDEX CDF TBLFLD TAD I 10 /SCAN THE TABLE FOR A MATCH CDF RGFLD SNA /SKIP IF NOT THE END OF THE TABLE JMP GETCOA /TRY THE NEXT VALUE. TAD LOOK1 /SEE IF IT IS THIS ONE (CONVERTED CHARACTER) SZA CLA /SKIP IF A MATCH IS FOUND JMP GETOP3 /TRY ANOTHER CLL CLA IAC R3L /AC=10 TAD GETOP1 /GET THE COLOR INDEX AND (17 /MASK TO VALID VALUE DCA COLSEE /AND SAVE IT JMP GETCOA /TRY ANOTHER CLRRP, 0 TAD COLSEE /END OF COLOR SELECTION. NOW DETERMINE WHAT HAS /TO BE DONE FOR HLS SUPPORT. SPA CLA /POSITIVE VALUE SAYS A COLOR HAS BEEN SPECIFIED JMP CLRRPB TAD COLSEE /GET SPECIFIED COLOR DCA SAVCLR /AND SAVE IT JMP CLRRPA /AND FINISH UP. CLRRPB, TAD HLSSEE /SEE IF HLS HAS BEEN SPECIFIED. SNA CLA /SKIP IF YES. JMS HLSCOL /GO ESTABLISH COLOR SPECIFIED. CLRRPA, DCA CHAR JMP I GETCOP /EXIT PAGE / /LOOKUP ROUTINE FOR PROCESSING NEXT LEVEL OF FUNCTION /THE ROUTINE WILL FIRST CONVERT ALL LOWER CASE CHARACTERS TO UPPER CASE AND /THEN PERFORM THE PROPER LOOKUP ON THE CONVERTED CHARACTER. /ENTER WITH THE CHARACTER IN THE AC; / CALL+1 = CHARACTER / CALL+2 = TABLE ADDRESS /EXIT TO: / CALL +3 IF INVALID SEQUENCE SEEN / CALL +4 IF VALID SEQUENCE SEEN AND ROUTINE ADDRESS IN THE AC. / LOOKUP, 0 RDF /ESTABLISH WHERE WE CAME FROM TAD (CIF CDF DCA LOOKEX /SAVE FOR LATER USE TAD I LOOKUP /GET THE CHARACTER ISZ LOOKUP /UPDATE THE POINTER DCA LOOK1 /SAVE THE CHARACTER TO DO TAD I LOOKUP /NOW THE TABLE ADDRESS ISZ LOOKUP DCA LOOKTM /SAVE TABLE ADDRESS FOR LATER. LOOKU2, TAD LOOKTM /SET UP TABLE ADDRESS. DCA LOOK2 /SAVE IT TAD LOOK1 JMS I XUPPER /MAKE UPPER CASE IF NECESSARY DCA LOOK1 LOOK3, CLA /MAKE SURE THE AC IS CLEAR CDF TBLFLD /TABLE FIELD TAD I LOOK2 /GET A COMPARISON VALUE CDF RGFLD /TO MAINTAIN THE PROPER FIELD DATA SNA /SKIP IF NOT DONE JMP LOOK7 /FUNCTION NOT FOUND. GO TEST FOR MATCHING PAIRS TAD LOOK1 /NOW DO THE COMPARISON SZA CLA /SKIP IF EQUAL. SAYS WE FOUND A MATCH JMP LOOK5 /GO UPDATE THE POINTERS ISZ LOOK2 /POINT TO THE ROUTINE CDF TBLFLD /BUFFER FIELD AGAIN TAD I LOOK2 /GET ROUTINE ADDRESS CDF RGFLD /RETURN TO THIS FIELD ISZ LOOKUP /UPDATE THE RETURN TO NON-ERROR JMP LOOKEX /AND EXIT TO VALID RETURN WITH ADDRESS IN THE AC LOOK5, ISZ LOOK2 ISZ LOOK2 /UPDATE THE POINTERS TO POINT TO THE /NEXT COMPARISON VALUE JMP LOOK3 LOOK7, TAD LOOK1 /SEE IF IT'S A COMMA TAD MCOMMA SNA CLA /THROW AWAY THE COMMA AND JMP LOOK7Z /GO GET ANOTHER CHARACTER TAD LOOK1 /GET THE CHARACTER AND START TESTING FOR /RUN DOWNS. TAD MLPREN /FIRST LEFT PAREN SZA CLA /SKIP IF YES JMP LOOK7A /GO TEST FOR "[" JMS LPRUN /RUN DOWN PARENS JMP LOOK7Z /GO TRY NEXT CHARACTER IN LINE LOOK7A, TAD LOOK1 /GET CHARACTER AGAIN TAD MLBRKT /LOOK FOR LEFT BRACKET SZA CLA /SKIP IF YES JMP LOOK7B JMS NULBKT /RUN DOWN BRACKETS JMP LOOK7Z /EXIT TO GET NEXT CHARACTER LOOK7B, TAD LOOK1 /NOW FOR QUOTES TAD MSGLQU SNA CLA /SKIP IF NOT SINGLE WUOTE JMP LOOK7W /GO PROCESS SINGLE QUOTE. (COMMON ROUTINE) TAD LOOK1 /NOW THE DOUBLE QUOTE TAD MDBLQU SNA CLA /SKIP IF NOT JMP LOOK7W /GO RUN DOWN QUOTES TAD LOOK1 /NOW TEST FOR NUMERICS. TAD (-60 SPA /SKIP IF NOT NUMERIC JMP LOOK7E /NOT THIS TAD (-11 /THE HIGH END SMA SZA CLA /SKIP IF WITHIN RANGE JMP LOOK7E /TAKE THE NOT FOUND EXIT DCA CHAR /CLEAR THE CURRENT CHARACTER JMP LOOK7Z /CONTINUE LOOK7W, TAD LOOK1 /PASS THE QUOTE TO THE RUN-DOWN ROUTINE JMS GTRUN /RUN DOWN A QUOTED STRING DCA LOOK1 /SAVE NEXT CHAR AS NEW LOOKUP TARGET JMP LOOKU2 /BACK IN LINE - TO PROCESS NEXT CHARACTER LOOK7E, CLA LOOKEX, HLT /MODIFIED TO CIF CDF CALLING FIELD JMP I LOOKUP /AND EXIT THE ROUTINE LOOK7Z, JMS CURLEV DCA LOOK1 /SAVE THE INCOMING CHARACTER JMP LOOKU2 /AND TRY AGAIN LOOK1, 0 /TEMPS FOR THIS ROUTINE LOOK2, 0 LOOKTM, 0 UPPER, 0 / DCA UPPETM /SAVE CHAR TAD UPPETM TAD (-141 /LOWER CASE A TO Z SPA /SKIP IF IT STILL LOOKS GOOD JMP UPPER8 /NOT LOWER CASE TAD M32 /THE RANGE OF CHARACTERS SMA CLA /SKIP IF WITHIN RANGE JMP UPPER8 /NOT LOWER CASE CHARACTER TAD UPPETM /MAKE IT UPPERCASE TAD M40 /THIS DOES IT DCA UPPETM /SAVE FOR RETURN / UPPER8, CLA CLL TAD UPPETM /GET CONVERTED CHAR JMP I UPPER /RETURN WITH CHAR, NOW UPPER-CASE / /RUN DOWN A QUOTED PAIR / GTRUN, 0 CIA /COMPLEMENT THE FIRST QUOTE DCA GTRNTM /SAVE IT FOR LATER COMPARES STA DCA LOACTV /PASS ALL CHARS / JMS CURLEV /GET NEXT CHARACTER DCA TXTCHR /SAVE AS FIRST IN STRING TAD TXTCHR /GET IT BACK JMP GTRUN6 / AND JUMP INTO NEXT LEVEL / GTRUN4, STA DCA LOACTV /RESET FLAG TO IGNORE EXPANDING A MARCO JMS CURLEV /MAKE THIS LEVEL GTRUN6, TAD GTRNTM /CHARACTER TO LOOK FOR SZA CLA /SKIP IF TERMINATOR - MAYBE JMP GTRUN4 /TRY ANOTHER DCA LOACTV /KNOCK DOWN IN CASE A MARCO COMES IN JMS CURLEV /NOW SEE IF NEXT CHARACTER IS A QUOTE DCA GTRNT1 /SAVE THE CHARACTER IN CASE TAD GTRNT1 TAD GTRNTM /COMPARE SNA CLA /SKIP IF NOT A TERMINATOR JMP GTRUN4 /TRY AGAIN TAD GTRNT1 /GET FIRST CHAR AFTER STRING JMS I XUPPER /MAKE UPPER-CASE IF NECESSARY JMP I GTRUN /EXIT ROUTINE WITH NEXT CHAR IN AC GTRNTM, 0 GTRNT1, 0 / / PAGE WOPSLB, 0 STA DCA NUMMER+2 JMS PBKT /GET THE SHADING REFERENCE LINE NOP /NEED BECAUSE OF STACK COMMANDS JMP I WOPSLB / /RESTORE THE POINT PREVIOUSLY SAVED / RESCUR, 0 TAD TEMP1 /RESTORE STARTING X DCA CURX+1 TAD TEMP1A DCA CURX+2 TAD TEMP2 /RESTORE STARTING Y DCA CURY+1 / TAD TEMP2A DCA CURY+2 JMS INT2FL CURX JMS INT2FL CURY /INTEGER TO FLOAT CONVERSION. JMP I RESCUR /B, S, AND E OPTIONS. / /THE FOLLOWING ROUTINES PROVIDE SUPPORT FOR THE B, S, AND E SUBOPTIONS /IN THE VECTOR, POSTION, AND CIRCLE COMMAND. THE B OPTION PUSHES A POINT /ONTO THE STACK. THE S OPTION IS SIMILAR TO THE B OPTION IN THAT IT PUSHES /A DUMMY ARGUMENT ONTO THE STACK AND ON THE E COMMAND HAS NO MEANING. THE /E OPTION POPS A POINT OF THE STACK AND CAUSE THE PROPER COMMAND TO BE /PERFORMED. / / /ROUTINE TO PUSH A POINT ONTO THE POSITION STACK. THE STACK IS 16 POINTS /DEEP. IT WILL TAKE THE CONTENTS OF CURX AND CURY AND STORE THEM WITH /THE FLAG INFORMATION CONTAINED IN THE AC. UPON ENTRY THE AC WILL CONTAIN /0 FOR A REAL POINT TO PUSH AND -1 FOR A DUMMY PUSH FOR THE S OPTION. / /STKPNT CONTAINS THE CURRENT LEVEL OF THE STACK AND CANNOT BE ANY GREATER /THAN 16 DECIMAL POINTS DEEP. / PUSHPT, 0 DCA STKTMP /SAVE WHATEVER IS IN THE AC / TAD STKPNT /SEE IF STACK IS ALREADY FULL TAD (-20 /MAX SIZE OF STACK SMA CLA JMP I PUSHPT /JUST RETURN IF ALREADY FULL / TAD STKPNT /CURRENT STACK DEPTH CLL RTL /MULTIPLY BY FIVE FOR OFFSET TO ACTUAL /STACK POINTER TAD STKPNT TAD (STACK-1 /MAKE THE POINTER FOR USE DCA 10 /SAVE THE POINTER. TAD STKTMP /GET THE CONTENTS OF THE AC DCA I 10 /SAVE THE FLAG DATA. IT TELL WHETHER IT /IS A REAL POINT OR A DUMMY ARGUMENT JMS FL2INT /CONVERT TO INTEGER CURX JMS FL2INT CURY TAD CURX+1 /CURRENT VALUE OF X DCA I 10 TAD CURX+2 DCA I 10 TAD CURY+1 /AND THE Y VALUE DCA I 10 TAD CURY+2 DCA I 10 JMS INT2FL CURX JMS INT2FL CURY ISZ STKPNT /NEXT ENTRY ON THE STACK (POST INCREMENT) JMP I PUSHPT /AND EXIT THE ROUTINE STKPNT, 0 STKTMP, 0 / /ROUTINE TO POP A POINT OF THE STACK. /IF THE STACK POINTER IS AT ZERO THEN UPDATES ARE NOT DONE ELSE THE POINTER /IS UPDATED. IF THE FIRST WORD IS NOT ZERO THEN IT IS A DUMMY POINT AND /THE ARGUMENTS ARE NOT RESTORED TO DXI+2 AND DYI+2. / POPPNT, 0 TAD STKPNT /SEE IF AT THE TOP OF THE STACK SNA CLA /IF YES DON'T DO THE UPDATE JMP I POPPNT /EXIT AS STACK IS EMPTY STA /(PRE-DECREMENT) TAD STKPNT /UPDATE AS NEEDED DCA STKPNT TAD STKPNT /CURRENT STACK DEPTH CLL RTL /MULTIPLY BY FIVE FOR OFFSET TO ACTUAL /STACK POINTER TAD STKPNT TAD (STACK-1 /MAKE THE POINTER FOR USE DCA 10 /SAVE THE POINTER. TAD I 10 /GET THE FLAG WORD SZA /SKIP IF THE POINT IS REAL AND EXIT WITH AC /THE ACSET FOR CALLING ROUTINE. JMP POPEX1 /TAKE THE UPDATE EXIT AND JUST UPDATE THE /POINTERS. TAD I 10 /CURX DCA CURX+1 TAD I 10 /CURX DCA CURX+2 TAD I 10 /CURY DCA CURY+1 TAD I 10 /CURY DCA CURY+2 JMS INT2FL CURX JMS INT2FL CURY POPEX1, JMP I POPPNT /TAKE THE EXIT. / /SAVE A DUMMAY ARGUMENT ON THE POSITION STACK. SAME AS ABOVE ROUTINE /EXCEPT A FLAG IS SENT TO THE STACK ROUTINES TO SAVE IT IS A DUMMY ARGUMENT. / SAVDUM, 0 STA JMS PUSHPT /SAVE THE CURRENT POINT AS A DUMMY ARGUMENT ISZ SAVDUM /UPDATE TO BYPASS EXECUTING ON RETURN JMP I SAVDUM /AND EXIT BACK TO CALLING ROUTINE. / /RESTORE THE LAST POSITION SAVED. IF THE AC RETURNS FROM THE POP ROUTINE /AS -1 THEN THE POSITION FUNCTION IS NOT DONE. / LASPOS, 0 JMS POPPNT /GET A POINT TO RESTORE. SZA CLA /SKIP IF IT IS A REAL POINT ISZ LASPOS JMP I LASPOS /AND EXIT. / /SCREEN MAP FUNCTION / SOPM, 0 SOPM1, JMS I XGETNU JMP SOPMB /INVALID NUMBER TAD NUMMER+2 /GET BACK THE NUMMER AND (17 /MASK TO A COLOR VALUE TAD (CMAPTB /OFFSET TO COLOR VALUE DCA SOPMTM /SAVE IT SOPMB, TAD CHAR /GET THE CHARACTER WHICH CAUSED THE EXIT. DCA SOPM2 /SAVE IT FOR A LOOKUP. JMS I XLOOKU /DO THE LOOKUP SOPM2, 0 CLRTB1 /COLOR BY LETTER JMP SOPMA /NOT A VALID CHARACTER DCA SOPM2 /SAVE THE ADDRESS OF THE ROUTINE JMS I SOPM2 /EXECUTE THE ROUTINE TAD SAVCLR /GET BACK THE COLOR SPECIFIED. SPA /SKIP IF A VALID COLOR JMP SOPM1 /TRY ANOTHER CDF TBLFLD /TABLE FIELD DCA I SOPMTM /SAVE THE COLOR MAP VALUE CDF RGFLD /HOME FIELD JMP SOPM1 /TRY ANOTHER SOPMA, CLL CLA TAD CHAR /FAILING CHARACTER JMP I SOPM /EXIT. SOPMTM, 0 / /DUMMY SUBROUTINE / DUMMY, 0 JMP I DUMMY / PAGE / /SCALING ALGORITHM / SCALER, 0 FPINT /CALL FLOATING PT /DELTA X IMPLENTATION = BX-TX FGET BX FSUB TX FPUT DXI /DELTA Y IMPLMENTATION = BY-TY FGET BY FSUB TY FPUT DYI /DELTA X REQUESTED = SCRBX+1 MINUS SCRTX+1 FGET SCRBX+1 FSUB SCRTX+1 FPUT DXR /DELTA Y REQUESTED = SCRBY+1 MINUS SCRTY+1 FGET SCRBY+1 FSUB SCRTY+1 FPUT DYR FEXT / X RATIO = DXI/DXR FPINT /GET BACK INTO FLOATING POINT FGET DXI FDIV DXR FPUT XR / Y RATIO = DYI/DYR FGET DYI FDIV DYR FPUT YR /TEST FOR ABS(YR/XR) >= 1 FGET YR FDIV XR FPUT NUMMER FEXT TAD NUMMER+1 SMA CLA JMP SC8 FPINT FGET NUMMER FMPY MINUS1+1 FPUT NUMMER FEXT SC8, FPINT FGET NUMMER FADD MINUS1+1 FPUT NUMMER FEXT TAD NUMMER+1 SMA CLA SPA CLA /THEN ABS(YR/XR) IS >=1 JMP SC10 /OR IF IT IS LESS THAN 1, GO HERE /SET S = ABS(XR) TAD XR+1 SMA CLA JMP SC9A FPINT FGET XR FMPY MINUS1+1 /MULT BY -1 TO GET ABSOLUTE VALUE FPUT S FEXT JMP SC11 SC9A, FPINT /SAVE THE VALUE OF XR INTO S FGET XR FPUT S FEXT JMP SC11 /SET S =ABS(YR) SC10, TAD YR+1 SMA CLA JMP SC10A FPINT FGET YR FMPY MINUS1+1 /MULT BY -1 TO GET ABSOLUTE VALUE FPUT S FEXT JMP SC11 SC10A, FPINT /SAVE THE POSITIVE VALUE OF YR INTO S FGET YR FPUT S FEXT /EXIT FLOATING POINT AND CONTINUE AT SC11 / X_FACTOR = (S)(SIGN(XR)) SC11, TAD XR+1 SMA CLA JMP SC11A FPINT FGET S FMPY MINUS1+1 FPUT XFACT FEXT JMP SC11B SC11A, FPINT FGET S FMPY PLUS1+1 FPUT XFACT FEXT / Y_FACTOR = (S)(SIGN(YR)) SC11B, TAD YR+1 SMA CLA JMP SC11C FPINT FGET S FMPY MINUS1+1 FPUT YFACT FEXT JMP SC12 SC11C, FPINT FGET S FMPY PLUS1+1 FPUT YFACT FEXT JMP SC12 /JUMP OVER PAGE BOUNDRY SCLREX, JMP I SCALER /RETURN S, 1; 2000; 0 /SCREEN SCALING (INITIAL VALUE, MAY CHANGE) XR, ZBLOCK 3 /TEMPORARY YR, ZBLOCK 3 /TEMPORARY / PAGE / X_OFFSET = TX + (DXI - ((DXR)(XFACT)) / --------------------- / 2 SC12, FPINT FGET XFACT FMPY DXR FPUT DXR FGET DXI FSUB DXR FDIV PLUS2 FADD TX FPUT XOFSET / Y_OFFSET = TY + (DYI - ((DYR)(YFACT)) / --------------------- / 2 FGET YFACT FMPY DYR FPUT DYR FGET DYI FSUB DYR FDIV PLUS2 FADD TY FPUT YOFSET FEXT JMP SCLREX /RETURN / /MACRO COMMAND SEEN TO REGIS /ACCEPT THE INCOMING DATA UNTIL A NEW COMMAND IS SEEN AT WHICH POINT A RETURN /TO THE MAIN LEVEL IS DONE TO ACCEPT THE NEW COMMAND. / AC = 0 AT ENTRY / MACRO, 0 JMS CURLEV /ESTABLISH THIS LEVEL OF PROCESSING FOR /NEXT INCOMING CHARACTER. JMS I XUPPER /GO MAKE UPPER CASE DCA CHAR TAD CHAR TAD M101 SPA JMP MACLUK /GO SEE IF IT IS A VALID MACRO FUNCTION TAD M32 /NOW CHECK THE HIGH END SMA CLA /SKIPS IF WITHIN RANGE JMP MACLUK /ALL DONE OR INVALID COMMAND TAD CHAR CIF TBLFLD JMP DOGRPH /GO EXECUTE THE DESIRED MACRO MACLUK, CLA TAD CHAR DCA MACCMD /SAVE IT FOR THE LOOKUP CIF RGFLD JMS LOOKUP /EXECUTE A LOOKUP MACCMD, 0 MACTAB /1ST LEVEL OPTION TABLE JMP MACERR /GO HERE ON ERROR DCA MACCMD /SAVE THE POINTER HERE ON RETURNING CIF TBLFLD JMS I MACCMD /AND DISPATCH TO POINTER ADDRESS / JMP MACROX /EXIT BACK TO MAIN LEVEL / MACERR, MACROX, CLA DCA CHAR /ALL DONE DCA SEMIOK /TERMINATE THE FUNCTION JMP I MACRO /RETURN / /SOPHP - SCREEN OPTION HARD COPY POSITION COMMAND / SOPHP, 0 JMS CURLEV /ESTABLISH THIS LEVEL TAD MLBRKT /SEE IF A LEFT BRACKET WAS INPUT SZA CLA JMP SOPHP8 /INVALID CHARACTER SO EXIT JMS TOPBKT /ELSE GO GET THE PARAMETERS TAD POSX /CHECK IF MISSING PARAMETER TO IGNORE SNA CLA /(WILL LOOK LIKE RELATIVE ZERO) JMP SOPHP2 /ABSOLUTE, GO USE IT TAD POSX+3 /RELATIVE, CHECK IF ZERO (IMPLIES MISSING) SNA CLA JMP SOPHP4 /IS RELATIVE ZERO, DON'T CHANGE THIS PARAMETER SOPHP2, TAD POSX+3 /REAL VALUE, MOVE INTO CONTROL BLOCK DCA HRDCPY+1 / SOPHP4, TAD POSY /CHECK IF MISSING PARAMETER TO IGNORE SNA CLA /(WILL LOOK LIKE RELATIVE ZERO) JMP SOPHP6 /ABSOLUTE, GO USE IT TAD POSY+3 /RELATIVE, CHECK IF ZERO (IMPLIES MISSING) SNA CLA JMP SOPHP8 /IS RELATIVE ZERO, DON'T CHANGE THIS PARAMETER SOPHP6, TAD POSY+3 /REAL VALUE, MOVE INTO CONTROL BLOCK DCA HRDCPY+2 SOPHP8, TAD CHAR /GET THE CHARACTER THAT TERMINATED INPUT JMP I SOPHP /AND RETURN FOR FURTHER PROCESSING / /SHBRKT - SCREEN OPTION HARD COPY COMMAND TO GET THE SCREEN PARAMETERS FROM THE / USER FOR PRINTING. / SHBRKT, 0 JMS CURLEV /ESTABLISH THIS LEVEL TAD MLBRKT /SEE IF CHAR IS A LEFT BRACKET SZA CLA JMP SHBRKX /EXIT IF IT IS JMS TOPBKT /ELSE GO GET THE DESIRED PARAMETERS TAD POSX+3 /TO BE THE UPPER LEFT CO-ORD DCA HRDCPY+3 TAD POSY+3 /TO BE THE TOP Y CO-ORD DCA HRDCPY+4 JMS CURLEV /NEW LEVEL TAD MLBRKT /LOOK FOR NEXT LEFT BRACKET SZA CLA JMP SHBRKX /GET OUT IF IT'S NOT (MUST BE DONE) JMS TOPBKT /GO GET NEXT PARAMETERS TAD POSX+3 /TO BE THE RIGHT X CO-ORD SNA TAD (1437 /FORCE DEFAULTS IF CAME BACK ZERO DCA HRDCPY+5 TAD POSY+3 /TO BE THE BOTTOM RIGHT CO-ORD SNA TAD (737 DCA HRDCPY+6 SHBRKX, TAD CHAR /GET THE CHAR THAT TERMINATED THE INPUT JMP I SHBRKT /RETURN FOR FURTHER PROCESSING / HRDCPY, -1 62 0 0 0 1437 737 PAGE / /SAVE A POSITION ON THE POSITION STACK. /USED BY AT LEAST THE VECTOR AND POSITION COMMAND AND POSSIBLY THE /CURVE COMMAND. / SAVPOS, 0 JMS PUSHPT /SAVE THE CURRENT POINT. THIS IS A REAL POINT /SO THE AC WILL BE CLEAR. ISZ SAVPOS /UPDATE TO BYPASS EXECUTING ON RETURN JMP I SAVPOS /AND EXIT BACK TO CALLING ROUTINE / /SCALE / SCAL, 0 FPINT FGET CURX /X_PHYS = (CURX-SCRTX+1)(XFACT) + XOFSET FSUB SCRTX+1 FMPY XFACT FADD XOFSET FPUT DXI /Y_PHYS = (CURY-SCRTY+1)(YFACT) + YOFSET FGET CURY /DO THE CALCULATIONS FSUB SCRTY+1 FMPY YFACT FADD YOFSET FPUT DYI FEXT /CONVERT TO INTEGERS JMS FL2INT DXI JMS FL2INT DYI JMP I SCAL /RETURN XFACT, 1; 2000; 0 /INITIAL VALUE MAY CHANGE YFACT, 1; 2000; 0 /INITIAL VALUE MAY CHANGE PLUS2, 2; 2000; 0 / /CLTXTY - ROUTINE TO CLEAR OUT LOCATIONS USED BY SCALER ROUTINE / CLTXTY, 0 FPINT FGET ZERO+1 /GET FLT. PT. ZERO FPUT NUMMER /NOW CLEAR OUT THE LOCATIONS FPUT TX FPUT TY FPUT BX FPUT BY FEXT JMP I CLTXTY /AND RETURN / /SETCLP - SET CLIPPING REGION ROUTINE / CALCULATES THE CLIPPING PARAMETERS TO BE SENT TO THE PRIMS / SETCLP, 0 /TSETTX = TX + XOFSET FPINT FGET TX FADD XOFSET FPUT NUMMER FEXT JMS FL2INT /CONVERT TO INTEGER NUMMER TAD NUMMER+2 DCA TSETTX /TSETTY = TY + YOFSET FPINT FGET TY FADD YOFSET FPUT NUMMER FEXT JMS FL2INT /CONVERT TO INTEGER NUMMER TAD NUMMER+2 DCA TSETTY /TSETBX = ((SCRBX-SCRTX)(XFACT)) + TX + XOFET FPINT FGET SCRBX+1 FSUB SCRTX+1 FMPY XFACT FADD TX FADD XOFSET FPUT NUMMER FEXT JMS FL2INT NUMMER TAD NUMMER+2 DCA TSETBX /TSETBY = ((SCRBY-SCRTY)(YFACT)) + TY + YOFET FPINT FGET SCRBY+1 FSUB SCRTY+1 FMPY YFACT FADD TY FADD YOFSET FPUT NUMMER FEXT JMS FL2INT NUMMER TAD NUMMER+2 DCA TSETBY JMP I SETCLP /EXIT PV0, 0 JMS MOVEP /ESTABLISH THE OFFSET PLUSX /+1 TO X ZERO /AND ZERO TO Y / JMS PVGEN /GO HERE TO TREAT THE NUMBERS AS RELATIVE / ISZ PV0 JMP I PV0 / /TEXT PIXEL VECTOR COMMAND PROCESSOR / TPV, 0 TAD CHAR AND (7 /MASK TO OFFSET VALUE DCA TPVBLK+1 TAD (TPVBLK /COMMAND BLOCK TO PRIMATIVES. CIF PRMFLD /FIELD OF PRIMATIVES. JMS I XPRIMS /CALL THE PRIMATIVES. JMS REQPOS /GET THE CURRENT POSITION JMP I TPV /AND EXIT TPVBLK, TPVCMD 0 /TEXT PIXEL VECTOR DIRECTION VALUE. PAGE / /WOPM SEPCIFY A PIXEL VECTOR MULTIPLIER / WOPM, 0 JMS I XGETNU /GET A NUMBER FOR THE MULTIPLIER. JMP WOPMA /ERROR IN NUMBER. JMS INT2FL /CONVERT TO FLOAT NUMMER TAD NUMMER+1 /NOW MAKE IT POSITIVE ONLY SMA CLA /SKIP IF VALUE IS NEGATIVE. JMP WOPMB /NOT NEGATIVE. FPINT FGET NUMMER FMPY MINUS1 /MAKE THE NUMBER POSITIVE FPUT NUMMER /STORE IT BACK FEXT /EXIT FLOATING POINT WOPMB, FPINT FGET NUMMER FPUT PMULT /STORE THE NEW PATTERN MULTIPLIER AS FLOATING /POINT NUMBER. FEXT JMS GENOFF /GO GENERATE THE PROPER VALUES /FOR PV STUFF. WOPMA, TAD CHAR JMP I WOPM /AND EXIT. POSX, ZBLOCK 4 /X POSITION POSY, ZBLOCK 4 /Y POSIITON PLUS1, -1; 1; 2000; 0 MINUS1, -1; 1; 6000; 0 / /CHKMAC - ROUTINE TO TEST IF A MACRO INTRODUCER IS IN LINE. /EXITS CALL+1 IF EITHER A DEFINITION OR A CLEAR MACROGRAPH / " CALL+2 IF NOT A MACRO INTRODUCER / CHKMAC, 0 TAD CHAR /GET THE CHARACTER TAD M100 /TEST FOR "@" INTRODUCER SZA CLA /SKIP IF MACRO INTRODUCER JMP CHKMC1 /TAKE THE NON-MACRO EXIT TAD CURLEV /GET CURRENT LEVEL OF EXECUTION CDF TBLFLD DCA I (LASACT /AND SAVE IT IF IT IS A REQUEST FOR A /MACRO EXECUTION CDF RGFLD JMS MACRO /GO TO THE MACRO PROCESSOR SKP /EXIT ROUTINE AS A MACRO DEFINITION OR CLEAR /MACRO WAS DONE. CHKMC1, TAD CHAR /RETURN HERE SAYS CONTINUE ON JMP I CHKMAC /EXIT / /GETHEX - MAKE A BINARY NUMBER FROM A HEX ASCII INPUT / GETHEX, 0 /GET A BINARY NUMBER FROM HEX ASCII / CLA CLL CMA RAL /ALLOW ONLY TWO HEX DIGITS PER CHARACTER DCA GETHT1 / DCA GETHT3 /MARK AS NO NUMBER YET / DCA GETHTM /CLEAR THE ACCUMULATED NUMBER / TAD CHAR /DO WE ALREADY HAVE A CHARACTER? SNA GETHE2, JMS CURLEV /IF NOT, GET A CHARACTER FROM USER JMS I XUPPER /MAKE CHARACTER UPPER-CASE IF NECESSARY TAD (-0060 /CHECK FOR DIGITS 0 - 9 SPA JMP GETHE8 /TOO LOW, CAN'T BE HEX TAD (-0011 SMA SZA JMP GETHE4 /NOT A DIGIT, GO CHECK FOR A - F / TAD (0011 /IS A DIGIT, RESTORE BINARY VALUE JMP GETHE6 / AND ACCUMULATE A NUMBER / GETHE4, TAD (-0010 /CHECK FOR LETTERS A - F SPA JMP GETHE8 /TOO LOW, CAN'T BE HEX TAD (-0005 SMA SZA JMP GETHE8 /TOO HIGH, CAN'T BE HEX / TAD (0017 /RESTORE BINARY VALUE GETHE6, DCA GETHT2 /SAVE THE NIBBLE FOR A WHILE / TAD GETHTM /GET THE PREVIOUS PARTS OF THE NUMBER R3L /SHIFT OVER BY A NIBBLE CLL RAL TAD GETHT2 /ADD IN THE NEW NIBBLE DCA GETHTM /SAVE AS ACCUMULATED NUMBER / STA /MARK AS HAVING SEEN A DIGIT DCA GETHT3 / ISZ GETHT1 /CHECK IF ENOUGH DIGITS JMP GETHE2 /LOOP FOR ANOTHER / DCA CHAR /CLEAR CHARACTER AS HAVING BEEN USED / GETHE8, CLA CLL TAD GETHTM /GET THE NUMBER ISZ GETHT1 /IF GETH1 = -1 THEN SHIFT ONE NIBBLE JMP GETHE9 R3L /SHIFT OVER BY A NIBBLE CLL RAL GETHE9, JMP I GETHEX /RETURN WITH NUMBER IN AC / / GETHTM, 0 GETHT1, 0 GETHT2, 0 GETHT3, 0 //***** COMMENTED OUT BECAUSE OF HARDWARE LIMITATIONS. // //PLANE SELECT SUBOPTION - WRITE OPTION (F) // VALID ARGUMENT IS 0-15 WITH MASKING TO THOSE 4 BITS // /WOPF, 0 / JMS I XGETNU / JMP WOPFA /ERROR EXIT. INVALID COLOR SELECTION VALUE, / /GO BACK TO PREVIOUS LEVEL AND DO ANOTHER OPTION / TAD NUMMER+2 /GET DESIRED COLOR / DCA PMASK /AND SAVE FOR LATER USE // //// CIF PRMFLD //// TAD (PLNSEL /POINTS TO THE COMMAND //// JMS I XPRIMS /SEND IT TO THE PRIMS / NOP / NOP / NOP /WOPFA, TAD CHAR /RETURN THE CHARACTER IN THE AC / JMP I WOPF // /PLNSEL, GTPLNS /PLANE SELECT COMMAND /PMASK, 0 /PLANE SELECT MASK / / /SET-UP STUFF / CIRSET, 0 TAD DXI+2 /GET THE CURRENT X POSTITION DCA CIRBLK+1 /CURRENT X VALUE TAD DYI+2 /Y POSITION DCA CIRBLK+2 JMP I CIRSET /RETURN / /DRAW TO LAST POSITION SAVED. /IF THE AC IS NOT ZERO UPON EXITING THE POP ROUTINE THEN JUST RUN DOWN THE /PARENS AND EXIT. / VCLSPS, 0 JMS POPPNT /GET THE LAST POINT SAVED. SZA CLA /SKIP IF A VALID POINT. ISZ VCLSPS JMP I VCLSPS /AND EXIT. PAGE // //COLOR MAP INITIALIZATION CODE. // // //INIMAP, 0 // TAD (CMAPTB-1 /INIT THE POINTERS // DCA 10 // TAD (-20 /16 WORDS // DCA TEMP1 // CLL CLA IAC R3L /MAKE 10 // DCA TEMP2 /STARTING MAP VALUE //INIMPA, TAD TEMP2 // AND (17 /MASK TO THE PROPER BITS. // CDF TBLFLD /TABLE FIELD // DCA I 10 // CDF RGFLD /THIS FIELD // ISZ TEMP2 /UPDATE THE PATTERN // ISZ TEMP1 /SEE IF DONE // JMP INIMPA /NOT YET. GO TRY IT AGAIN // JMP I INIMAP /AND EXIT / /SCREEN COMMAND TO REGIS /TO THE MAIN LEVEL IS DONE TO ACCEPT THE NEW COMMAND. / AC = 0 AT ENTRY / SCREEN, 0 SCRENA, JMS CURLEV /ESTABLISH THIS LEVEL OF PROCESSING FOR /NEXT INCOMING CHARACTER. DCA SCRCMD /SAVE IT FOR THE LOOKUP JMS I XLOOKU /EXECUTE A LOOKUP SCRCMD, 0 SCRTAB /1ST LEVEL OPTION TABLE JMP SCRERR /GO HERE ON ERROR DCA SCRCMD /SAVE THE POINTER HERE ON RETURNING JMS I SCRCMD /AND DISPATCH TO POINTER ADDRESS / JMP SCRENA /GET NEXT CHAR AND RE-ESTABLISH THIS LEVEL / SCRERR, FINI /GO BACK TO MAIN LEVEL / /INPUT A PATTERN MULTIPLIER VALUE / WOPPM, 0 JMS I XGETNU /GET THE MULTIPLIER VALUE JMP WOPPME /ERROR, JUST EXIT WITH NO CHANGE TAD NUMMER+2 DCA PATMUL WOPPME, TAD CHAR JMP I WOPPM /EXIT. / /CLEANUP - ROUTINE TO CLEANUP UPON RE-ENTERING AFTER A TEXT OR MACRO CMD. / CLEANU, 0 CLEAN1, TAD TYTETM /NOW CHECK FOR PREV. ACTIVE TEXT SZA CLA JMS RSTPOS /HAD BEEN ACTIVE, GO RESTORE CURSOR BLOCK DCA TYTETM DCA SEMIOK / JMP I CLEANU /RETURN / CLEAN2, CIF TBLFLD /CHANGE TO FIELD 5 JMS NULLGR /GO CLEAR ALL MARCO'S JMP CLEAN1 /RETURN TO NORMAL PROCESSING / /INT2FL - INTEGER TO FLOATING POINT /CONVERT THE CONTENTS OF THE ADDRESS AT CALL+1 INTO FLOATING POINT FORMAT / INT2FL, 0 CLL CLA IAC /AC=1 TAD I INT2FL /GET THE POINTER DCA INT2TM /SAVE IT TAD I INT2TM /GET THE ACTUAL VALUE DCA INT2TM+2 /AND SAVE IT FOR CONVERSION ISZ INT2TM /POINT TO THE LOW ORDER PORTION OF THE INTEGER TAD I INT2TM DCA INT2TM+3 CLA CLL CMA RAL / AC = -2 TAD INT2TM DCA INT2TM /SAVE THE ACTUAL ADDRESS OF THE STORAGE FPINT /CALL FP INTERPRETER FGET INT2TM+1 FEXT TAD K27 /NEEDED TO NORMALIZE DCA EXP FPINT FNOR FPUT I INT2TM /SAVE IT TO WHERE IT CAME FROM FEXT ISZ INT2FL /UPDATE THE RETURN JMP I INT2FL /AND THEN RETURN / INT2TM, ZBLOCK 4 /DOVEC - EXECUTE THE VECTOR COMMAND BY CALLING THE PRIMATIVE PACKAGE / DOVEC, 0 JMS SCAL TAD DXI+2 /GET THE CURRENT X POSTITION DCA VBX /CURRENT X VALUE TAD DYI+2 /Y POSITION DCA VBY CIF PRMFLD TAD (VECBLK /POSITION BLOCK DATA JMS I XPRIMS /TO THE PRIMATIVES JMP I DOVEC / /DOTXT - EXECUTE THE TEXT COMMAND BY CALLING THE PRIMATIVE PACKAGE / AND LEAVE THE "TXFLAG" = NO CHANGE WHEN FINISHED. / DOTXT, 0 CIF PRMFLD TAD (TXTBLK /TEXT BLOCK DATA JMS I XPRIMS /TO THE PRIMATIVES TAD TXFLAG /GET THE TEXT FLAG SPA SNA /SKIP IF PLUS 1 OR GREATER DCA TCHNGE /SAVE FLAG IF 0 FOR BASELINE OR -1 FOR ESCPMT CLL CLA IAC /AC=1 DCA TXFLAG /SET TEXT BLOCK TO = NO CHANGE JMP I DOTXT /RETURN / TUSBKT - TEXT USER SCALING BRACKETED PAIR HANDLING / TUSBKT, 0 / JMS BKTPAR /GET A PAIR OF VALUES POSX POSY / TAD POSX /ENSURE NEGATIVE VALUES SEEN AS ZERO SPA CLA DCA POSX / TAD POSY SPA CLA DCA POSY / FPINT /START FLOATING POINT OPERATIONS FGET POSX+1 /GET 'X' VALUE FMPY S /SCALE FOR USER COORDINATES FPUT POSX+1 /PUT IT BACK FGET POSY+1 /SAME FOR 'Y' VALUE FMPY S FPUT POSY+1 FEXT /END OF FLOATING POINT STUFF / JMS FL2INT /FIX 'X' POSX+1 / JMS FL2INT /FIX 'Y' POSY+1 / JMP I TUSBKT /RETURN PAGE / /CURVE ARC FUNCTION. /DRAWS AN ARC WITH THE SPECIFIED RADIUS. IF THE RADIUS IS GREATER THAN /-+ 360 THEN A COMPLETE CIRCLE IS DRAWN REGARDLESS. / CURARC, 0 FPINP /GET THE FLOATING POINT NUMBER FPINT FPUT ARCVAL /STORE THE VALUE FEXT /EXIT INTERPRETER. TAD ARCVAL+1 /SEE IF THE VALUE IS NEGATIVE TO CHECK FOR -360 SMA CLA /SKIP IF VALUE IS NEGATIVE. JMP ARC1 /NO. ON TO POSITIVE CHECKING. FPINT /FLOATING INTERPRETER FGET ARCVAL /VALUE TO FPAC FADD K360 /FLOAT 360 FPUT TEMPO+1 /GET IT BACK FEXT TAD TEMPO+2 /SEE IF STILL NEGATIVE. (INVALID NUMBER) SMA CLA /SKIP IF OUT OF RANGE JMP ARC2 /VALID NUMBER FPINT FGET K360 /SET IT TO MINUS 360 DEGREES. FMPY MINUS1+1 FPUT ARCVAL FEXT JMP ARC2 ARC1, FPINT /FLOATING INTERPRETER FGET ARCVAL /VALUE TO FPAC FSUB K360 /FLOAT 360 FPUT TEMPO+1 /GET IT BACK FEXT TAD TEMPO+2 /SEE IF STILL NEGATIVE. (INVALID NUMBER) SPA SNA CLA /SKIP IF OUT OF RANGE JMP ARC2 /VALID NUMBER FPINT FGET K360 /SET IT TO MINUS 360 DEGREES. FPUT ARCVAL FEXT ARC2, JMS FL2INT /FLOAT TO INTEGER ARCVAL /CONVERT THIS TO INTEGER TAD ARCVAL+2 DCA CIRBLK+3 /SAVE THE ARC VALUE. TAD CHAR /RETURN CHARACTER PREVIOUS LEVEL JMP I CURARC /AND EXIT. ARCVAL, ZBLOCK 3 /THREE WORDS FOR IT. / /BEGIN UNBOUNDED CURVE / UNBCUR, 0 TAD (CRVBGN /SET UP START UNBOUNDED CURVE COMMAND DCA CIRSTA /SAVE IT JMS STACUR /START CURVE COMMAND TO PRIMATIVES. JMP I UNBCUR /AND EXIT ROUTINE / /BEGIN BOUNDED CURVE. / BOUCUR, 0 TAD (CRVCLS /SET UP START UNBOUNDED CURVE COMMAND DCA CIRSTA /SAVE IT JMS STACUR /START CURVE COMMAND TO PRIMATIVES. JMP I BOUCUR /AND EXIT ROUTINE / /START A BOUNDED SEQUENCE. / STACUR, 0 JMS SCAL /SCALE THE CURRENT STUFF TAD DXI+2 DCA CIRSTA+1 /STARTING X TAD DYI+2 DCA CIRSTA+2 /STARTING Y TAD (CRVCNT-DRWARC /OFFSET VALUE FOR CURVE DRAW ROUTINE DCA CURACT /SAVE IT TAD (CIRSTA /CURVE START FUNCTION CIF PRMFLD /PRIMATIVE FIELD JMS I XPRIMS JMP I STACUR /EXIT ROUTINE CIRSTA, 0 /DEFINED AS NEEDED 0 0 / ENDBLK, CRVEND /END CURVE BLOCK. /THE RANGE CHECK ROUTINE HAS BEEN REMOVED TO MAKE ROOM FOR GENERATING THE /CORRECT OFFSET WITH PIXEL VECTOR COMMANDS (P0 OR V0) / /RANGE - CHECK THE INTEGER AT NUMBER+2 TO SEE THAT IT IS BETWEEN 0 AND THE 12 BIT / INTEGER AT CALL+1, WHERE CALL+1 = THE MAXIMUM SPECIFIED VALUE. IF GREATER / THEN MODULO SUBTRACTION IS PERFORMED UNTIL THE VALUE IS LESS THAN THE / MAX. VALUE SECIFIED AND THIS VALUE IS RETURNED TO NUMBER+2 WITH ITS / ORIGINAL SIGN. /RANGE, 0 / CLA / TAD I (RANGE /GET THE MAXIMUM VALUE ALLOWED / DCA TEMPO /SAVE HERE FOR USE / ISZ RANGE /BUMP THE RETURN TO CALL+2 /CHECK SIGN OF NUMMER+2 / TAD NUMMER+2 /GET THE INTEGER / SMA CLA /SKIP IF NEGATIVE / JMP RANGE2 /ELSE PROCESS THE POSITIVE VALUE / / TAD NUMMER+2 /GET THE VALUE BACK /RANGE1, TAD TEMPO /GET THE NEGATIVE NUMBER / SPA /IF STILL POSITIVE IT'S OK / JMP RANGE1 /OTHERWISE SUBTRACT UNTIL IT IS / CMA IAC /MAKE IT A NEGATIVE VALUE / DCA NUMMER+2 /AND THEN SAVE IT FOR USE LATER / JMP RANGEX /THEN EXIT / /RANGE2, TAD TEMPO /GET THE MAX VALUE / CMA IAC /FORM 2'S COMPLEMENT FOR SUBTRACTION / DCA TEMPO /AND SAVE IT / TAD NUMMER+2 /GET THE VALUE TO BE CHECKED /RANGE3, TAD TEMPO /ADD THE 2'S COMPLEMENT OF THE MAX VALUE / SMA /SKIP IF NEGATIVE / JMP RANGE3 /OR SUBTRACT THE VALUE UNTIL IT IS / CMA IAC /2'S COMPLEMENT TO GET IT BACK TO ORIGINAL SIGN / DCA NUMMER+2 /SAVE FOR LATER USE / /RANGEX, JMP I RANGE /RETURN / /ROUTINE TO GENERATE THE PROPER VALUES OF OFFSET FOR PV FUNCTIONS / GENOFB, 0 GENOFF, 0 TAD XFACT+1 /CALCUALTE THE PLUS AND MINUS X VALUE BASED /ON THE SIGN OF XOFFSET VALUE. SMA CLA /SKIP IF SIGN IS NEGATIVE. SAYS THE OFFSET WILL /BE NEGATIVE AS WELL JMP GENOFA /NOT NEGATIVE JUST MOVE IN A PLUS AND MINUS ONE TAD (MINUS1+1 SKP GENOFA, TAD (PLUS1+1 DCA GENOFB /SAVE THE REAL OFFSET VALUE FPINT /NOW CALL THE FLOATING POINT UNIT FGET I GENOFB /GET THE OFFSET VALUE FMPY PLUS1+1 /CALCULATE THE REAL VALUE FMPY PMULT /FOR THE REAL VALUE FPUT PLUSX+1 FGET I GENOFB /GET BACK THE OFFSET FMPY MINUS1+1 FMPY PMULT /FOR THE REAL VALUE FPUT MINUSX+1 FEXT /DONE WITH THE X VALUE / /NOW GENERATE THE Y OFFSETS. / TAD YFACT+1 /CALCUALTE THE PLUS AND MINUS Y VALUE BASED /ON THE SIGN OF YOFFSET VALUE. SMA CLA /SKIP IF SIGN IS NEGATIVE. SAYS THE OFFSET WILL /BE NEGATIVE AS WELL JMP GENOFC /NOT NEGATIVE JUST MOVE IN A PLUS AND MINUS ONE TAD (MINUS1+1 SKP GENOFC, TAD (PLUS1+1 DCA GENOFB /SAVE THE REAL OFFSET VALUE FPINT /NOW CALL THE FLOATING POINT UNIT FGET I GENOFB /GET THE OFFSET VALUE FMPY PLUS1+1 /CALCULATE THE REAL VALUE FMPY PMULT /FOR THE REAL VALUE FPUT PLUSY+1 FGET I GENOFB /GET BACK THE OFFSET FMPY MINUS1+1 FMPY PMULT /FOR THE REAL VALUE FPUT MINUSY+1 FEXT /DONE WITH THE X VALUE JMP I GENOFF /EXIT THE ROUTINE. PAGE / /HLS SUPPORT ROUTINES. / CLRH, 0 DCA HLSSEE JMS I XGETNU /GET A NEW VALUE JMP CLRH8 /INVALID NUMBER TAD NUMMER+2 /SAVE THE NUMMER RETURNED DCA HUENUM /SAVE THE NEW VALUE CLRH8, TAD CHAR /RETURN THE CHARACTER JMP I CLRH CLRL, 0 DCA HLSSEE JMS I XGETNU /GET A NEW VALUE JMP CLRL8 /INVALID NUMBER TAD NUMMER+2 /SAVE THE NUMMER RETURNED DCA LIGNUM /SAVE THE NEW VALUE CLRL8, TAD CHAR /RETURN THE CHARACTER JMP I CLRL CLRS, 0 DCA HLSSEE JMS I XGETNU /GET A NEW VALUE JMP CLRS8 /INVALID NUMBER TAD NUMMER+2 /SAVE THE NUMMER RETURNED DCA SATNUM /SAVE THE NEW VALUE CLRS8, TAD CHAR /RETURN THE CHARACTER JMP I CLRS / /HLS TO COLOR ROUTINE. / HLSCOL, 0 CLL CLA HLSCLI, TAD LIGNUM /LIGHTNESS VALUE TAD (-16 SPA SNA CLA /IF LESS THAN OR EQUAL TO 14 THEN VALUE = BLACK JMP HLSCLA TAD LIGNUM /HIGH END. IF GREATER THAN 86 THEN MAKE IT /WHITE. TAD (-126 SPA CLA JMP HLSCLB TAD (17 /SET TO MAX JMP HLSCLA /AND PROCESS IT. HLSCLB, TAD SATNUM /GET THE SAVED VALUE TAD (-41 SMA SZA CLA JMP HLSCLK TAD LIGNUM TAD (-52 SMA SZA CLA TAD (5 TAD (7 JMP HLSCLA HLSCLK, TAD LIGNUM /NOW MAKE THE COLOR VALUE TO USE. TAD (-52 SMA CLA /SKIP IF INTENSITY BIT TO BE SET. CLL CLA IAC R3L /AC=10 TO ASSERT INTENSITY BIT. DCA HLSCTM /SAVE IT FOR LATER USE TAD SATNUM /NOW DETERMINE THE SATURATION VALUE. TAD (-41 /COVER THE CASE OF GREY SCALES. SMA CLA JMP HLSCLC TAD (7 /WHITE TAD HLSCTM /ADD IN THE INTENSITY BIT. JMP HLSCLA /GO PROCESS IT. HLSCLC, TAD HUENUM /GET THE HUE VALUE TAD (35 HLSCLE, SPA JMP HLSCLD TAD (-550 /-360 DEGREES. JMP HLSCLE /HUE PLUS 29(MOD 360) HLSCLD, SMA JMP HLSCLF TAD (550 /+360 JMP HLSCLD /STAY IN THE LOOP FOR MOD 360. HLSCLF, DCA HLSCT1 /SAVE THE HLS VALUE FOR THE LOOKUP. DCA HLSCT2 /ASSUME DIVIDE BY 60. = 0 TAD HLSCT1 / HLSCLH, TAD (-74 /SUBTRACT 60 SPA /SEE IF MOD DONE YET JMP HLSCLG /DONE. CONTINUE THE PROCESSING. ISZ HLSCT2 /UPDATE THE COUNTER FOR COLOR VALUE NOP /IN CASE OF OVER FLOW JMP HLSCLH /AND TRY AGAIN. HLSCLG, CLL CLA /BECAUSE THE AC MAY NOT BE CLEAR TAD HLSCT2 /((HUE+30)MOD360)DIV 60 TAD (TABLEB /OFFSET TO GET THE REAL COLOR VALUE DCA HLSCT2 CDF TBLFLD TAD I HLSCT2 CDF RGFLD /HOME FIELD TAD HLSCTM HLSCLA, DCA SAVCLR JMP I HLSCOL /AND EXIT. / /TEMPS USED BY HLS ROUTINE. / HLSCTM, 0 HLSCT1, 0 HLSCT2, 0 / /CONVERT THE CHARACTER IN THE AC TO SEVEN BIT AND SAVE IN "CHAR". RETURN /WITH THE CHARACTER IN THE AC IN SEVEN BIT MODE. / MAKE7, 0 AND (177 /MASK TO SEVEN BITS DCA CHAR TAD CHAR JMP I MAKE7 /EXIT WITH CHARACTER IN AC PAGE / /TOPS - TEXT SIZE OPTION / TOPS, 0 JMS I XGETNU /GET THE INPUT JMP TOPSEX /NON-NUMERIC, SO EXIT TAD NUMMER+2 /CHECK FOR NEGATIVE NUMBERS SPA CLA JMP TOPS4A /NEGATIVE, GO SAVE A ZERO VALUE TOPS1, TAD NUMMER+2 /CHECK FOR NUMBER > 16 DECIMAL TAD (-21 SPA CLA JMP TOPS4 /VALID NUMBER, GO USE IT CLA CLL IAC /TOO HIGH, FORCE DEFAULT TO ONE JMP TOPS4A TOPS4, TAD NUMMER+2 /GET THE NUMBER BACK TOPS4A, DCA TXSBLK / TOPS3, TAD TXSBLK TAD (SZTBL /FORM AN INDEX INTO THE SIZE TABLE DCA SAVS1 TAD I SAVS1 /GET THE STARTING ADDR DCA SAVS1 /THIS IS THE "FROM" POINTER TAD (TCELLH DCA SAVS2 /THIS IS THE "TO" POINTER INTO THE TEXT CMD BLK TAD (-4 /WANT TO DO 4 WORDS DCA SAVS3 /SAVE FOR COUNTING JMS SWAPIT /GO SWAP THE LOCATIONS / CLL CLA DCA TXFLAG /SET FLAG TO BASELINE INDICATION = 0000 TAD TCHRAN /GET THE CELL ROTATION DCA TBASES /AND PUT IN THE BASELINE ANGLE TOPS5, JMS DOTXT /SEND IT TO THE PRIMS TOPSEX, CLA TAD CHAR /GET THE CHAR BACK TAD MLBRKT /SEE IF CHAR IS AN OPENING BRACKET "[" SZA CLA /SKIP IF YES JMP TOPSE1 /IT WASN'T SO JUST EXIT /OTHERWISE GET THE DESIRED CELL WIDTH AND HEIGHT JMS TUSBKT /NOW DO DEFAULT PARAMETER CHECKING TAD POSX+3 /GET THE NUMERAL SZA DCA TCELLW TAD POSY+3 SZA DCA TCELLH JMP TOPS5 /SEND THE TEXT BLOCK TO THE PRIMS TOPSE1, TAD CHAR /GET THE CHARACTER WHICH TERMINATED THE INPUT JMP I TOPS /RETURN / /TEXT BEGIN - SAVE THE TXTBLK DATA / TOPB, 0 TAD (TXTBLK+1 /FROM THIS ADDRESS DCA SAVS1 TAD (TXSAVE /TO THIS BLOCK DCA SAVS2 TAD (-13 /THIS MANY WORDS DCA SAVS3 JMS SWAPIT /DO IT JMP I TOPB /RETURN / /TEXT END - RESTORE TXTBLK DATA / TOPE, 0 TAD (TXSAVE /FROM THIS BLOCK DCA SAVS1 TAD (TXTBLK+1 /TO THIS BLOCK DCA SAVS2 TAD (-13 /THIS MANY WORDS DCA SAVS3 JMS SWAPIT /DO IT TAD TCHNGE /GET THE CHANGE FLAG DCA TXFLAG /AND UPDATE THE TEXT FLAG WITH IT JMS DOTXT /SEND IT TO THE PRIMS JMP I TOPE / /ROUTINE TO SWAP DATA FROM ONE BLOCK TO ANOTHER / SWAPIT, 0 SWAPS, TAD I SAVS1 /FROM THIS ADDR DCA I SAVS2 /TO HERE ISZ SAVS1 /BUMP PTRS AND COUNTER ISZ SAVS2 ISZ SAVS3 JMP SWAPS /LOOP UNTIL DONE JMP I SWAPIT /DONE, SO RETURN / /TEXT SAVE BLOCK FOR TEXT BEGIN/END DATA / TXSAVE, ZBLOCK 13 /FOR SAVING TXTBLK+1 TO TXTBLK+13 / / TXSBLK, 0 SAVS1, 0 SAVS2, 0 SAVS3, 0 SZTBL, SIZE0 SIZE1 SIZE2 SIZE3 SIZE4 SIZE5 SIZE6 SIZE7 SIZE8 SIZE9 SIZE10 SIZE11 SIZE12 SIZE13 SIZE14 SIZE15 SIZE16 PAGE / /TOPM - TEXT OPTION M(ULTIPLIER) COMMAND / TOPM, 0 JMS CURLEV /ESTABLISH THEIS LEVEL TAD MLBRKT /SEE IF A LEFT BRACKET "[" SZA CLA JMP TOPMEX /IT'S NOT SO EXIT / JMS TOPBKT /GO GET THE PARAMETERS JMS INT2FL /HAVE TO CONVERT BACK TO FLT. PT. POSX+1 JMS INT2FL POSY+1 /NOW DO THE MULTIPLICATION FPINT /ENTER FLOATING POINT INTERPRETER FGET POSX+1 FMPY KFP8 /MULTIPLY BY 8(DECIMAL) FPUT POSX+1 /SAVE IT FGET POSY+1 FMPY KFP10 /MULTIPLY BY 10(DECIMAL) FPUT POSY+1 FEXT /EXIT FLOATING POINT /CONVERT BACK TO INTEGERS AND SAVE IT INTO TEXT BLOCK JMS FL2INT /CONVERT BACK TO INTEGER POSX+1 JMS FL2INT POSY+1 TAD POSX+3 /GET AN INTEGER SNA /IF ZERO TAD (10 /FORCE IT TO DEFAULT TO 8(DECIMAL) DCA TUNITW /SAVE THE WIDTH TAD POSY+3 /GET THE NEXT INTEGER SNA /IF ZERO TAD (24 /DEFAULT TO 20(DECIMAL) DCA TUNITH /SAVE THE HEIGHT JMS DOTXT /CALL THE PRIMS TOPMEX, TAD CHAR /GET BACK THE CHARACTER WHICH TERMINATED INPUT JMP I TOPM /AND RETURN TO PREVIOUS LEVEL / /TOPU - TEXT OPTION 'U' COMMAND / TOPU, 0 JMS CURLEV /ESTABLISH THEIS LEVEL TAD MLBRKT /SEE IF A LEFT BRACKET "[" SZA CLA JMP TOPUEX /IT'S NOT SO EXIT / JMS TUSBKT /CHECK FOR ZERO OR MISSING INPUT PARAMETERS TAD POSX+3 /GET THE INTEGER SZA DCA TUNITW /SAVE INTO TEXT BLOCK TAD POSY+3 /GET THE INTEGER SZA DCA TUNITH /SAVE INTO TEXT BLOCK JMS DOTXT /SEND DATA TO THE PRIMS TOPUEX, TAD CHAR /GET CHAR THAT TERMINATED INPUT JMP I TOPU /AND RETURN TO PREVIOUS LEVEL /TOPBKT - ROUTINE TO GET A BRACKETED PAIR ARGUMENT INTO POSX AND POSY / AS INTEGERS / TOPBKT, 0 JMS BKTPAR /CALL BRACKETED PAIR ROUTINE POSX POSY JMS FL2INT /CONVERT TO INTEGER POSX+1 JMS FL2INT POSY+1 JMP I TOPBKT /EXIT / /TOPH -TEXT OPTION H(EIGHT) COMMAND / TOPH, 0 JMS I XGETNU /GET THE INPUT JMP TOPHEX /NON-NUMERIC, SO EXIT TAD NUMMER+2 /CHECK FOR NEGATIVE NUMBERS SMA CLA JMP TOPH1 /ZERO OR POSITVE TOPH2, CLL CLA IAC /FORCE DEFAULT OF HEIGHT 1 DCA TXSBLK JMP TOPH3 TOPH1, TAD NUMMER+2 /CHECK FOR NUMBER > 16 DECIMAL TAD (-21 SMA CLA JMP TOPH2 /NUMBER WAS GREATER THAN 16., SO SAVE A ONE TOPH3, JMS INT2FL /CONVERT BACK TO F.P. NOTATION NUMMER FPINT /ENTER FLT. PT. INTERPRETER FGET NUMMER /GET THE NUMER TO BE ACTED ON FMPY KFP10 /MULTIPLY BY 10 DECIMAL FPUT NUMMER /SAVE IT FEXT /EXIT FLOATING POINT /CONVERT BACK TO AN INTEGER AND SAVE IN THE UNIT AND CELL HEIGHT JMS FL2INT NUMMER TAD NUMMER+2 /GET THE INTEGER DCA TCELLH /SAVE HERE TAD NUMMER+2 /GET IT AGAIN DCA TUNITH /SAVE HERE ALSO JMS DOTXT /SEND IT TO THE PRIMS TOPHEX, TAD CHAR /GET THE CHARACTER WHICH TERMINATED THE INPUT JMP I TOPH /RETURN KFP8, 4; 2000; 0 /FLOATING POINT CONSTANT FOR 8 (DECIMAL) KFP10, 4; 2400; 0 /FLOATING POINT CONSTANT FOR 10 (DECIMAL) / / / REPORT CURSOR POSITION - JUST SENDS 060 015 FOR NOW / ROPP, 0 TAD (060 /ASCII FOR ZERO DCA RPTBLK+1 /PUT IN BLOCK TO SEND STA /SETUP A -1 DCA RPTBLK+2 /TO END THE REPSONSE TAD (RPTBLK DCA REPLY /TELL VT125 MODULE THERE'S DATA WAITING JMP I ROPP /RETURN RPTBLK, 7775 /CURSOR POSITION REPORT BLOCK ZBLOCK 12 PAGE / SIZE0, 12; 11; 12; 10 SIZE1, 24; 11; 24; 10 SIZE2, 36; 22; 36; 20 SIZE3, 55; 33; 50; 30 SIZE4, 74; 44; 74; 40 SIZE5, 113; 55; 106; 50 SIZE6, 132; 66; 132; 60 SIZE7, 151; 77; 144; 70 SIZE8, 170; 110; 170; 100 SIZE9, 207; 121; 202; 110 SIZE10, 226; 132; 226; 120 SIZE11, 245; 143; 240; 130 SIZE12, 264; 154; 264; 140 SIZE13, 276; 165; 276; 150 SIZE14, 322; 176; 322; 160 SIZE15, 341; 207; 334; 170 SIZE16, 360; 220; 360; 200 / / / POSITION STACK - SIXTEEN DECIMAL POSITIONS DEEP / STACK, ZBLOCK 120 /FLOATING POINT PACKAGE / /THIS PACKAGE HANDLES 3 WORD FLOATING POINT WORDS. / FPNT, 0 FPNTA, CLA CLL DCA OVER1 DCA OVER2 TAD I FPNT DCA JUMP TAD JUMP AND PAGENO /PAGE 0 ?? SNA CLA JMP .+3 /YES TAD MASK5 /NO - GET PAGE BITS AND FPNT DCA ADDRS TAD MASK7 /GET 7 BIT ADDRESS AND JUMP TAD ADDRS DCA ADDRS TAD INDRCT /BIT3 = 1 ?? AND JUMP SNA CLA JMP LOOP01 TAD I ADDRS /YES - DEFER DCA ADDRS LOOP01, ISZ FPNT TAD I ADDRS DCA EX1 /EXPONENT TAD ADDRS DCA SAVE ISZ SAVE TAD I SAVE /HIGH ORDER DCA HIGH1 ISZ SAVE TAD I SAVE DCA LOW1 /LOWER BITS TAD JUMP CLL RTL RTL AND MASK3 /LOOK-UP ON TABLE TAD TABLE DCA JUMP2 TAD I JUMP2 DCA JUMP2 JMS I JUMP2 /EXECUTE JMP FPNTA /GET NEXT JUMP, 0 JUMP2, 0 ADDRS, 0 SAVE, 0 MASK3, 0017 PAGENO, 0200 INDRCT, 0400 MASK5, 7600 MASK7, 0177 TABLE, FPTBLE /FLOATING GET = 5000 / FLGT, 0 FLGTA, TAD EX1 DCA EXP TAD HIGH1 DCA HORDER TAD LOW1 DCA LORDER JMP FPNTA /FLOATING EXIT OR SUBROUTINE = 00XX FEXIT, 0 JMP I FPNT / /WOPN - WRITE OPTION NEGATE / WOPN, 0 DCA NEGBLK+1 /CLEAR JMS I XGETNU /SEE IF NON-ZERO JMP WOPNA / = 0 SO GO CLEAR NEGATE MODE TAD NUMMER+2 DCA NEGBLK+1 /SAVE IN COMMAND BLOCK WOPNA, CIF PRMFLD TAD (NEGBLK JMS I XPRIMS TAD CHAR /GET THE CHARACTER BACK THAT TERMINATED INPUT JMP I WOPN /AND THEN RETURN / NEGBLK, GTNEGM 0 / / /INPUT A DECIMAL DIGIT. RETURN CALL +2 AND AC= NUMBER IF VALID /AND CALL PLUS ONE AC=0 IF NOT VALID. GETDIG, 0 JMS CURLEV /THIS LEVEL FOR PROCESSING TAD (-60 /NOW SEE IF IT IS NUMERIC OR NOT. SPA /SKIP IF STILL VALID JMP GETDGC /NOT NUMERIC TAD (-12 /HIGH END +1 SMA /SKIP IF STILL VALID. JMP GETDGC /TAKE THE EXIT. COMMAND TERMINATED. TAD (12 /MAKE THE CHARACTER BINARY ISZ GETDIG JMP I GETDIG GETDGC, CLL CLA JMP I GETDIG /FLOATING PUT = 6000 FLPT, 0 TAD EXP DCA I ADDRS TAD HORDER ISZ ADDRS DCA I ADDRS TAD LORDER ISZ ADDRS DCA I ADDRS JMP FPNTA *6000 / /FLOATING ADD = 1000 / FLAD, 0 JMS ALIGN /ALIGN WORDS JMP I FLAD /NO ALIGNMENT JMS SCALE CLA CLL /TRIPLE ADDITION TAD OVER1 TAD OVER2 DCA OVER2 RAL /CARRY TAD LOW1 TAD LORDER DCA LORDER RAL TAD HIGH1 TAD HORDER DCA HORDER JMS I NORMAL JMP I FLAD / /FLOATING SUBTRACT = 2000 / FLSU, 0 JMS I OPMINS /NEGATE OPERAND JMS FLAD JMP I FLSU / /ALIGN BIANRY POINTS / ALIGN, 0 TAD HORDER SZA CLA JMP ALIGNA TAD EX1 /C(FAC) = 0 DCA EXP JMP DONE ALIGNA, TAD HIGH1 SNA CLA JMP I ALIGN /OPERAND = 0 TAD EX1 CMA IAC TAD EXP SNA JMP DONE /EXPONENTS EQUAL - EXIT SMA CMA IAC DCA AMOUNT /NUMBER OF PLACES TAD AMOUNT TAD TEST1 SPA CLA JMP NOGO /NO SHIFTING POSSIBLE TAD EX1 CMA IAC TAD EXP RAL SNL CLA TAD TCON1 /SHIFT OPERAND RIGHT TAD TCON2 /SHIFT FAC RIGHT DCA POINT JMS I POINT ISZ AMOUNT JMP .-2 DONE, ISZ ALIGN JMP I ALIGN NOGO, TAD EX1 CMA IAC TAD EXP SMA CLA JMP I ALIGN JMP I .+1 FLGTA POINT, 0 AMOUNT, 0 NORMAL, FNORM OPMINS, OPNEG TEST1, 0030 TCON1, SHFTOP-SHFTAC TCON2, SHFTAC / /SCALE BOTH RIGHT / SCALE, 0 JMS SHFTOP JMS SHFTAC JMP I SCALE / /SCALE FLOATING AC RIGHT / SHFTAC, 0 CLA CLL TAD HORDER SPA CML RAR DCA HORDER TAD LORDER RAR DCA LORDER TAD OVER2 RAR DCA OVER2 ISZ EXP NOP JMP I SHFTAC / /SCALE OPERAND RIGHT / SHFTOP, 0 CLA CLL TAD HIGH1 SPA CML RAR DCA HIGH1 TAD LOW1 RAR DCA LOW1 TAD OVER1 RAR DCA OVER1 ISZ EX1 NOP JMP I SHFTOP SNDMUL, 0 TAD PATMUL DCA PTMUL /SAVE THE CURRENT PATTERN VALUE TAD (MULBLK /LINE TEXTURE PATTERN CIF PRMFLD /TO THE PRIMATIVES JMS I XPRIMS /CALL THEM JMP I SNDMUL /EXIT MULBLK, GTLMLT /FUNCTION 36 PTMUL, 0 / ROPE, 0 STA /SETUP A -1 DCA RPTBLK+1 /TO END THE REPSONSE TAD (RPTBLK DCA REPLY /TELL VT125 MODULE THERE'S DATA WAITING JMP I ROPE /RETURN / /NORMALIZE FLOATING POINT ACCUMULATOR / *6200 FNORM, 0 CLA CLL DCA MP1 /0 # OF SHIFTS DCA MP3 /RESET SWITCH TAD HORDER SPA /INPUT < 0 ISZ MP3 /YES, SET SWITCH SZA CLA /FAC = 0 ? JMP GO6 /NO TAD LORDER SZA CLA JMP GO6 /NO TAD OVER2 SZA CLA JMP GO6 /NO DCA EXP /YES JMP I FNORM /EXIT GO6, TAD MP3 SZA CLA /WAS INPUT < 0 JMS ACNEG /YES SHIFT, TAD HORDER CLL RAL SPA CLA /TOO FAR ? JMP NOREXT /YES, EXIT ROUTINE TAD OVER2 /NO CLL RAL DCA OVER2 /SHIFT LEFT TAD LORDER RAL DCA LORDER TAD HORDER RAL DCA HORDER ISZ MP1 /ADD 1 TO COUNT JMP SHIFT /CONTINUE NOREXT, TAD MP1 /SUBTRACT COUNT FROM EXPONENT CMA IAC TAD EXP DCA EXP TAD MP3 /WAS INPUT < 0 ? SZA CLA JMS ACNEG /YES JMP I FNORM /EXIT / /NEGATE FLOATING AC / ACNEG, 0 CLA CLL TAD OVER2 CMA IAC DCA OVER2 TAD LORDER CMA SZL CLL IAC DCA LORDER TAD HORDER CMA SZL CLL IAC DCA HORDER JMP I ACNEG /NEGATE OPERAND OPNEG, 0 CLA CLL TAD OVER1 CMA IAC DCA OVER1 TAD LOW1 CMA SZL CLL IAC DCA LOW1 TAD HIGH1 CMA SZL CLL IAC DCA HIGH1 JMP I OPNEG MULTIP, 0 DCA MP1 DCA MPSCON TAD THIR DCA MP3 CLL MULTA, TAD MP1 RAR DCA MP1 TAD MPSCON SNL JMP .+3 CLL TAD MP2CON RAR DCA MPSCON ISZ MP3 JMP MULTA TAD MP1 RAR CLL JMP I MULTIP MP1, 0 MP2CON, 0 MP3, 0 MPSCON, 0 THIR, -14 FMULT1, FMULT FLMY, 0 JMS I FMULT1 JMS FNORM DCA OVER2 ISZ I SIGN1 JMP I FLMY JMS ACNEG JMP I FLMY SIGN1, SGNTST SVTBLK, SVTXTO / / FPTBLE, FEXIT FLAD FLSU FLMY FLDV FLGT FLPT FNORM *6400 / /FLOATING MULTIPLY / FMULT, 0 CLA IAC TAD EX1 TAD EXP DCA EXP /ADD EXPONENTS TAD M100 DCA I SGNSW /SET UP SIGN ROUTINE JMS I SIGNP / AND GO THERE TAD LOW1 DCA I MP2 TAD LORDER /C*F JMS I DMULT CLA TAD I MP5 DCA OVER2 TAD HORDER DCA I MP2 TAD LOW1 /A*F JMS I DMULT TAD OVER2 DCA OVER2 RAL TAD I MP5 DCA MUL3 RAL DCA MUL2 TAD HIGH1 DCA I MP2 TAD LORDER /D*C JMS I DMULT TAD OVER2 DCA OVER2 RAL TAD MUL3 TAD I MP5 DCA MUL3 RAL TAD MUL2 DCA MUL2 TAD HORDER DCA I MP2 TAD HIGH1 /A*D JMS I DMULT TAD MUL3 DCA LORDER RAL TAD MUL2 TAD I MP5 DCA HORDER JMP I FMULT / MUL2, 0 MUL3, 0 SGNSW, SGNSWT SIGNP, SIGNCL DMULT, MULTIP MP2, MP2CON MP5, MPSCON / /REQPOS - REQUEST POSITION ROUTINE / REQPOS, 0 CIF PRMFLD TAD (RQBLK /REQUEST CURRENT POSITION JMS I XPRIMS DCA DXI+1 /CLEAR THESE PRIOR TO USING THEM DCA DYI+1 TAD RQBLK+1 DCA DXI+2 /UPDATE CURRENT X POSITION TAD RQBLK+2 DCA DYI+2 /UPDATE CURRENT Y POSITION JMS MOVDXY /UPDATE CURX AND CURY ALSO JMP I REQPOS /RETURN RQBLK, RETPOS /REQUEST POSITION FROM PRIMITIVES COMMAND BLOCK 0 0 / / / /FLOATING DIVIDE = 4000 / *6600 FLDV, 0 TAD EX1 /SUBTRACT EXPONENTS CMA IAC TAD EXP IAC DCA EXP TAD SPACLA DCA SGNSWT JMS SIGNCL /SET UP SIGNS TAD HIGH1 SNA CLA /DIVISOR = 0 ?? JMP DVER /YES, ERROR CLA CLL DCA QUOL TAD MIF DCA DIVCNT JMP DVX DV3, TAD LORDER RAL DCA LORDER TAD HORDER RAL DCA HORDER DVX, TAD LOW1 /PARTIAL SUBTRACT TAD LORDER DCA DTEM1 RAL TAD HIGH1 TAD HORDER SNL /DIVISOR < DIVIDEND ?? JMP DV2A /NO DCA HORDER /YES, C(L) = QUOTIENT BIT TAD DTEM1 DCA LORDER DV2A, CLA TAD QUOL /SHIFT BIT INTO QUOTIENT RAL DCA QUOL TAD OVER2 RAL DCA OVER2 ISZ DIVCNT /DONE ? JMP DV3 /NO TAD QUOL DCA LORDER TAD OVER2 DCA HORDER DCA OVER2 JMS I NORMIT DEXIT, ISZ SGNTST JMS I FACNEG JMP I FLDV / DVER, CLA CMA /DIVIDE ERROR DCA LORDER CMA CLL RAR DCA HORDER TAD HORDER DCA EXP ISZ FLAG NOP JMP DEXIT / NORMIT, FNORM QUOL, 0 DTEM1, 0 DIVCNT, 0 MIF, -27 /STEP COUNT SPACLA, SPA CLA / /TEST SIGN SUBROUTINE / SIGNCL, 0 CLA CMA CLL RAL / AC = -2 DCA SGNTST TAD HORDER SMA CLA JMP .+3 JMS I FACNEG ISZ SGNTST TAD HIGH1 SGNSWT, SMA CLA /OR SPA CLA JMP I SIGNCL JMS I OPNEGS ISZ SGNTST NOP JMP I SIGNCL / FACNEG, ACNEG OPNEGS, OPNEG SGNTST, 0 /WRITE P SUBOPTION ROUTINE / WOPPO, 0 WOPPOA, JMS CURLEV /GET THE LEVEL OF EXECUTION WOPPOB, DCA WOPPOC /SAVE THE CHARACTER JMS I XLOOKU /DO THE LOOKUP WOPPOC, 0 WRTPOT /TABLE ADDRESS JMP WOPPOA /STAY HERE UNTIL TERMINATOR IS SEEN DCA WOPPOC /SAVE THE ROUTINE ADDRESS JMS I WOPPOC JMP WOPPOB /RETURNS WITH THE CHARACTER IN THE AC WOPPOX, 0 JMP I WOPPO /TAKE THE EXIT ROUTINE AS A ")" WAS SEEN TO /TERMINATE THE FUNCTION. / /SAVE THE CURRENT X AND Y VALUE / SAVCUR, 0 JMS FL2INT CURX JMS FL2INT CURY TAD CURX+1 DCA TEMP1 TAD CURX+2 DCA TEMP1A TAD CURY+1 DCA TEMP2 TAD CURY+2 DCA TEMP2A JMS INT2FL CURX JMS INT2FL CURY JMP I SAVCUR YOFSET, ZBLOCK 3 /FLT PNT I/O SUBROUTINES / /4 WORD FLOATING POINT I/O SUBROUITNES /REQUIRES FLOATING POINT INTERPRETER /ENTRY IS AT 0007 /REQUIRED DEFINITIONS TO MAKE THIS FUNCTION PROPERLY. /(FIXMRI IS A PAL PSEUDO-OP) FIXMRI FADD= 1000 FIXMRI FSUB= 2000 FIXMRI FMPY= 3000 FIXMRI FDIV= 4000 FIXMRI FGET= 5000 FIXMRI FPUT= 6000 FIXMRI FNOR= 7000 FIXMRI FEXT= 0000 *52 FPAC1, 0 0 0 SWIT1, 7777 /IF = 0, NO CRLF AFTER OUTPUT SWIT2, 7777 /IF = 0, NO LF AFTER CR IN INPUT CHAR, 0 /CONTAINS LAST CHAR READ DSWIT, 0 /IS = 0 IF NO CONVERSION TOOK PLACE / /DOUBLE PRECISION DECIMAL TO BINARY /INPUT AND CONVERSION / *7000 DECONV, 0 CLA /INITIALIZE MANTISSA DCA HORDER DCA LORDER DCA SIGN DCA DNUMBR JMS CURLEV /ESTABLISH CURRENT INPUT LEVEL TAD PLUS /TEST FOR SIGN SNA JMP DECON1 TAD MINUS SZA JMP DECON2 /CHARACTER IS ALREADY THERE CLA CMA DCA SIGN /IF MINUS, SET SWITCH DECON1, STA DCA ABSFLG /MARK ABSOLUTE/RELATIVE MODE DECON, JMS CURLEV /THIS LEVEL OF PROCESSING DECON2, CLA TAD CHAR /IS IT A DIGIT TAD MIN9 SMA JMP I DECONV /NO TAD PLUS12 SPA JMP I DECONV /NO DCA DIGIT /YES TAD HORDER AND MASK /OVERFLOW ?? SZA JMP DECON /YES, IGNORE ISZ DSWIT ISZ DNUMBR /INDEX NUMBER OF DIGITS JMS MULT10 JMP DECON /CONTINUE MULT10, 0 /ROUTINE TO MULTIPLY DOUBLE TAD LORDER / PRECISION WORD BY 10 (DECIMAL) DCA LOW1 /DOUBLE PRECISION WORD TAD HORDER /REMAIN=REMAINDER DCA HIGH1 DCA EX1 JMS MULT2 /CALL SUBROUTINE TO JMS MULT2 /MULTIPLY BY TWO JMS DUBLAD /CALL DOUBLE ADD JMS MULT2 TAD DIGIT /ADD LAST DIGIT RECEIVED DCA LOW1 DCA HIGH1 JMS DUBLAD TAD EX1 /EXIT WITH REMAINDER JMP I MULT10 /IN AC / MULT2, 0 /MULTIPLY LORDER, HORDER BY 2 / CLA CLL TAD LORDER RAL DCA LORDER TAD HORDER RAL DCA HORDER TAD EX1 RAL DCA EX1 JMP I MULT2 DUBLAD, 0 /DOUBLE PRECISION ADDITION CLA CLL TAD LORDER TAD LOW1 DCA LORDER RAL TAD HORDER TAD HIGH1 DCA HORDER RAL TAD EX1 DCA EX1 JMP I DUBLAD MSIGN, 0 /ROUTINE TO FORM CLA CLL /2'S COMPLEMENT ISZ SIGN /IF C(SIGN)=7777 JMP I MSIGN JMS I MSIGNX JMP I MSIGN MSIGNX, ACNEG /"ACNEG" IN INTERPRETER /ALL CHARACTER CODES ARE IN SEVEN BIT MINUS, 53-55 /TEST FOR SIGN PLUS, -53 MIN9, -72 /TEST FOR DIGIT PLUS12, 72-60 MASK, 7600 /TEST FOR OVERFLOW CD10, 7775 3146 3147 / /WOPP ROUTINE TO PROCESS A PATTERN VALUE / WOPP, 0 WOPPA, JMS GETPAT /GET A PATTERN DCA PATTRN /SAVE THE PATTERN SPECIFIER TAD CHAR /RETURN THE CHARACTER TO THE CALLER DCA WOPPC /DO A LOOKUP ON THE INVALID CHARACTER JMS I XLOOKU WOPPC, 0 WOPPOP JMP WOPPE /EXIT, NOT IN TABLE DCA WOPPC JMS I WOPPC JMP WOPPA /AND TRY AGAIN WOPPE, JMS SNDPAT /SEND THE PATTERN JMS SNDMUL /AND THE MULTIPLIER TAD CHAR /AND RETURN THE INVALID CHARACTER JMP I WOPP /AND EXIT / /CURVE END COMMAND. / ENDCUR, 0 TAD (ENDBLK /FUNCTION BLOCK CIF PRMFLD /PRMATIVE FIELD JMS I XPRIMS /CALL THE PRIMATIVES CLA JMS REQPOS /RESTORE THE CURRENT POSITION DCA CURACT /TERMINATE THE CURVE FUNCTION JMP I ENDCUR /AND EXIT DXI, ZBLOCK 3 DYI, ZBLOCK 3 *7200 PLUSX, -1; 1; 2000; 0 PLUSY, -1; 1; 2000; 0 MINUSX, -1; 1; 6000; 0 MINUSY, -1; 1; 6000; 0 / /FLOAT TO INTEGER CONVERSION ROUTINE / FL2INT, 0 DCA FL2EXP /INIT THE VALUES TO START WITH DCA FL2HI DCA FL2LOW TAD I FL2INT /GET VALUES TO CONVERT TO INTEGERS ISZ FL2INT /UPDATE THE RETURN PC DCA FL2A /SAVE THE POINTER. TAD FL2A DCA FL3A /FOR FINAL STORAGE FPINT FGET I FL2A FADD PLUSP5 /ROUND UP ALWAYS???????? FPUT I FL2A FEXT TAD I FL2A /GET THE EXPONENT ISZ FL2A /UPDATE THE POINTER / SMA SZA /IS THE NUMBER <1? SMA JMP .+3 /NO CLA /YES. FIX IT TO ZERO??? JMP DONE1 TAD (-27 /NO. SET BINARY POINT AT SNA /35 PLACES TO RIGHT OF CURRENT POSITION JMP DONE1 /IT IS ALREADY THERE. ALL DONE SMA /TEST TO SEE IF IT IS TO LARGE. HLT /YES: NUMBER >2**23 DCA FL2EXP /NO. SET SCALE COUNT. TAD I FL2A /HIGH ORDER MANTISSA DCA FL2HI ISZ FL2A TAD I FL2A /LOW ORDER MANTISSA DCA FL2LOW / FGO, CLL TAD FL2HI /FETCH HIGH ORDER MANTISSA SPA /IS IT <0 CML /YES RAR /SCALE RIGHT DCA FL2HI TAD FL2LOW /SCALE RIGHT ALSO RAR DCA FL2LOW / ISZ FL2EXP /SEE IF ALL DONE JMP FGO /AND TRY AGAIN DONE1, TAD FL2EXP /GET THE EXPONENT DCA I FL3A ISZ FL3A TAD FL2HI DCA I FL3A ISZ FL3A TAD FL2LOW DCA I FL3A JMP I FL2INT /AND EXIT THE ROUTINE FL2A, 0 FL3A, 0 FL2EXP, 0 FL2HI, 0 FL2LOW, 0 PLUSP5, 0; 2000; 0 DIVTWO, 0 /DIVIDE BY TWO IE. ROTATE RIGHT CLL RAR DCA TEMP1 /TEMPORARY STORAGE TAD HORDER RAR DCA HORDER TAD LORDER RAR DCA LORDER TAD TEMP1 JMP I DIVTWO TOPA, 0 /TEXT DISPLAY ALPHABET SELECT / JMS I XGETNU /GET THE ALPHABET NUMBER JMP TOPA8 /NON-NUMERIC, JUST RETURN / TAD NUMMER+2 /GET THE SELECTED ALPHABET NUMMER DCA TDISPL /STORE IN PRIMITIVES COMMAND BLOCK / JMS DOTXT /SEND IT TO THE PRIMS / TOPA8, TAD CHAR /GET THE NEXT CHAR, IF ANY JMP I TOPA /RETURN WITH NEXT CHAR / / /DALBLK, GTCSET /PRIMITIVES COMMAND BLOCK TO PASS / 0000 / DISPLAY ALPHABET SELECTION SNDPAT, 0 TAD PATTRN DCA PATRN /SAVE THE CURRENT PATTERN VALUE TAD KPATBL /LINE TEXTURE PATTERN CIF PRMFLD /TO THE PRIMATIVES JMS I XPRIMS /CALL THEM JMP I SNDPAT /AND EXIT KPATBL, PATBLK PATBLK, GTLTXT PATRN, 0 CLRBMP, 0 TAD (LDCBLK+2 /SET UP TO CLEAR THE CHARACTER BITMAP DCA 10 TAD (-0012 DCA LDCHTM CLRBM1, DCA I 10 ISZ LDCHTM JMP CLRBM1 / TAD (LDCBLK+3 /SET UP TO SAVE BYTES IN THE BITMAP DCA LDCHT1 / POINTER TAD (-0012 DCA LDCHTM / COUNTER JMP I CLRBMP /RETURN *7400 / /FLOATING POINT INPUT / FLINTP, 0 CLA CMA /INITIALIZE "PERIOD SWITCH" DCA PRSW DCA DSWIT JMS I DPCVPT / 7777 = NO PERIOD CLA TAD CHAR TAD PER SZA CLA JMP FIGO1 TAD PRSW /PERIOD FOUND SNA CLA /SECOND PERIOD ? JMP FIGO2 /YES, TERMINATE DCA I DPN /NO, SET NUMBER OF DIGITS TO 0 DCA PRSW /SET PERIOD SWITCH TO 0 JMP I DPCSPT /CONVERT REST OF STRING FIGO1, TAD PRSW /PERIOD READ IN PREVIOUSLY ? SNA CLA FIGO2, TAD I DPN /YES, -NUMBER OF DIGITS IN SEXP CMA IAC /NO DCA SEXP JMS I MSGPNT /TEST SIGN TAD K27 DCA EXP FPINT /NORMALIZE F.P. NUMBER FNOR FPUT FPAC1 /SAVE NUMBER FEXT TAD CHAR TAD MINUSE SZA CLA /"E" READ IN ? JMP ENDFI /NO JMS I DPCVPT /YES, CONVERT DECIMAL EXPONENT JMS I MSGPNT /TEST SIGN TAD HORDER /EXPONENT TOO LARGE ?? SPA IAC SZA CLA JMP EXCESS /YES TAD LORDER /NO, DECIMAL POINT IS TAD SEXP /C(SEXP) PLACES TO RIGHT DCA SEXP /OF LAST DIGIT / /END OF FLOATING POINT INPUT /COMPENSATE FOR DECIMAL EXPONENTS / ENDFI, FPINT /RESTORE MANTISSA FGET FPAC1 FEXT ENDFIA, TAD SEXP SNA JMP I FLINTP SMA CLA JMP FIGO4 FPINT /. IS TO THE LEFT: FMPY I PCD10 /TIMES .1000 FEXT ISZ SEXP JMP ENDFIA JMP I FLINTP FIGO4, FPINT /. IS TO THE RIGHT, FMPY TEN /MULTIPLY BY 10 FEXT CLA CMA TAD SEXP DCA SEXP JMP ENDFIA EXCESS, TAD C3777 DCA EXP TAD C3777 DCA HORDER JMP I FLINTP TEN, 0004 2400 0000 PCD10, CD10 /.10 MINUSE, -105 PER, -56 PRSW, 0 SEXP, 0 /CONTAINS DECIMAL EXPONENT C3777, 3777 / DPCVPT, DECONV DPCSPT, DECON MSGPNT, MSIGN DPN, DNUMBR PATTAB, 0 /LINE PATTERNS = 377 / 11111111 360 / 11110000 344 / 11100100 252 / 10101010 352 / 11101010 210 / 10001000 204 / 10000100 310 / 11001000 206 / 10000110 XOFSET, ZBLOCK 3 / /MOVDXY - CONVERT DXI/DYI TO F.P. AND UPDATE CURX/CURY, THEN CHANGE BACK TO / INTEGERS /*********************CONVERT BACK TO USER SCALE VALUES. MOVDXY, 0 /CONVERT FROM INTEGER TO FLOATING POINT JMS INT2FL DXI JMS INT2FL DYI /UPDATE CURX AND CURY FPINT FGET DXI FSUB XOFSET /CALCULATION FOR INVERSE SCALING. FDIV XFACT FADD SCRTX+1 FPUT CURX FGET DYI FSUB YOFSET /CALCULATION FOR INVERSE SCALING. FDIV YFACT FADD SCRTY+1 FPUT CURY FEXT /CHANGE BACK TO INTEGERS JMS FL2INT DXI JMS FL2INT DYI JMP I MOVDXY /EXIT PAGE /LOAD CHARACTER CODE FOR REGIS / LDCHAR, 0 /LOAD CHARACTER COMMAND - HERE FROM << L >> / DCA CHAR /CLEAR OLD CHAR ON ENTRY ??? / CLA IAC /NEED TO GET SEMICOLONS AND SPACES AT THIS LEVE DCA SEMIOK / LDCHA2, DCA LDCBLK+2 /CLEAR THE CHARACTER CODE UNTIL SPECIFIED / LDCHA6, TAD LDCBLK+1 /CHECK IF ALPHABET DEFINED SNA CLA JMP LDCHA7 /NOT YET, GO CHECK FOR DEFINITION / TAD LDCBLK+2 /CHECK IF CHARACTER CODE SPECIFIED SNA CLA JMP LDCHA7 /NOT YET, GO CHECK FOR SPECIFICATION / JMS GETHEX /CHECK FOR ANY HEX-ENCODED DATA DCA I LDCHT1 /SAVE IN THE CHARACTER BITMAP / TAD GETHT3 /CHECK IF VALID DATA SNA CLA JMP LDCHA8 /NO, SKIP BUMPING POINTER AND COUNTER ISZ LDCHT1 /DATA OK, BUMP POINTER THROUGH BITMAP ISZ LDCHTM /INCREMENT COUNTER JMP LDCHA6 /LOOP THROUGH BITMAP DATA / JMS LDCSND /HAVE ALL DATA, SEND CHAR TO PRIMS / JMP LDCHA2 /START ON ANOTHER CHARACTER / LDCHA7, JMS CLRBMP /CLEAR THE CHARACTER BIT MAP / LDCHA8, TAD CHAR /CHECK IF ALREADY HAVE A CHARACTER SNA JMS CURLEV /IF NOT, GET ON NOW DCA LDCH10 /SAVE FOR LOOKUP JMS LOOKUP LDCH10, 0 /(BECOMES CHARACTER TO COMPARE) LOADTB /'LOAD' COMMAND MAIN TABLE JMS LDCEND /NOT FOUND, SEND ANY PARTIAL BITMAP DCA LDCH10 /FOUND, SAVE ROUTINE ADDRESS JMS I LDCH10 / AND CALL IT / JMP LDCHA6 /BACK TO CHECK FOR CHARACTER DATA / JMS GETHEX /CHAR NOT FOUND, CHECK FOR RANDOM HEX DATA CLA CLL /DISCARD THE DATA TAD GETHT3 /CHECK IF THERE WAS DATA, REALLY SZA CLA JMP LDCHA6 /YES, STAY AT THIS LEVEL JMP I LDCHAR /NO, BACK TO MAIN LEVEL / / LDCHTM, 0 LDCHT1, 0 / LDCBLK, GTCBMP /PRIMITIVE CONTROL BLOCK FOR LOAD CHARACTER 0000 /ALPHABET 0000 /CHARACTER CODE ZBLOCK 12 /TEN BYTE CHARACTER BITMAP LDCOPT, 0 /LOAD CHARACTER OPTION - HERE FROM << L( >> / JMS LDCSND /SEND ANY PARTIALLY COMPLETED BITMAP / JMP LDCOP4 /SKIP TO GET A NEW CHARACTER ON FIRST ENTRY / LDCOP2, TAD CHAR /DO WE HAVE A CHARACTER? SNA /IF SO, SKIP GETTING ANOTHER / LDCOP4, JMS CURLEV /GET ANOTHER CHARACTER FROM USER DCA LDCOP6 /SAVE FOR LOOKUP JMS LOOKUP LDCOP6, 0 /(BECOMES CHARACTER TO COMPARE) LDOPTB /LOAD OPTIONS TABLE JMP LDCOP4 /IF NOT FOUND, TRY ANOTHER / DCA LDCOP6 /SAVE ADDRESS OF ROUTINE JMS I LDCOP6 / AND CALL IT / JMP LDCOP2 /TRY ANOTHER CHARACTER / / LDOPEN, 0 /END OF LOAD OPTIONS - HERE ON << L(...) >> / DCA CHAR /CLEAR THE ')' FROM FURTHER CONSIDERATION / JMP I LDCOPT /RETURN FROM OPTIONS ROUTINE / LDCALP, 0 /LOAD CHARACTER ALPHABET - HERE FROM << L(A >> / JMS I XGETNU /GET THE ALPHABET NUMBER / JMP LDCAL8 /RETURN WITH NO CHANGE IN ALPHABET / TAD NUMMER+2 /GET THE ALPHABET NUMBER DCA LDCBLK+1 /SAVE IN THE CONTROL BLOCK / LDCAL8, JMP I LDCALP /RETURN / LDCABO, 0 /LOAD CHARACTER ABORT - HERE FROM << ; >> / DCA SEMIOK /SEMICOLONS CAN AGAIN ABORT COMMANDS / JMP I LDCHAR /GO RESET TO MAIN COMMAND LEVEL / LDCCOD, 0 /LOAD CHARACTER CODE - HERE FROM << L' >> / JMS LDCSND /SEND ANY PARTIALLY COMPLETED CHARACTER / TAD CHAR /GET THE QUOTE THAT STARTED US OFF JMS GTRUN /RUN DOWN THE QUOTES AND GET A CHARACTER CLA CLL /CLEAR AC (HAS NEXT CHAR AFTER QUOTE) / TAD TXTCHR /GET A CHARACTER FROM THE STRING DCA LDCBLK+2 /SAVE AS THE CHARACTER CODE BEING LOADED / JMP I LDCCOD /RETURN / / LDCOMM, 0 /LOAD CHARACTER COMMA HANDLER / DCA CHAR /BLOW AWAY THE COMMA CHARACTER / JMP I LDCOMM /AND RETURN / / LDCEND, 0 /LOAD CHARACTER TERMINATION << L'A'12,34,56; >> / JMS LDCSND /SEND ANY PARTIALLY COMPLETED BITMAP / JMS LDCABO /CALL ANOTHER ROUTINE THAT RETURNS TO MAIN / COMMAND LEVEL / / LDCSND, 0 /LOAD CHARACTER SENDING BITMAP TO PRIMITIVES / TAD LDCBLK+1 /CHECK IF ALPHABET SPECIFIED SNA CLA JMP LDCSN8 /NOT YET, SKIP SENDING / TAD LDCBLK+2 /CHECK IF CHARACTER CODE SPECIFIED SNA CLA JMP LDCSN8 /NOT YET, SKIP SENDING / CIF PRMFLD /OK TO SEND, CALL THE PRIMITIVES TAD (LDCBLK JMS I XPRIMS / DCA LDCBLK+2 /CLEAR THE CHARACTER CODE / JMS CLRBMP /GO CKEAR THE CHARACTER BITMAP / LDCSN8, JMP I LDCSND /RETURN / / JSTFY, 0 DCA 12 /SAVE THE COUNT TAD 10 CLL RAL ISZ 12 JMP .-2 JMP I JSTFY FIELD TABASY *1 /CONSTANTS NEEDED BY MACRO-GRAPH HANDLING. MACCUR, 0 MSTART, 0 / / *TABADD WRTPOT, -"M+200 /WOPP SUBOPTION TABLE WOPPM -")+200 WOPPOX 0 WOPPOP, -"(+200 WOPPO 0 MCMD, -"P+200 /POSITION COMMAND POSIT -"V+200 /VECTOR COMMAND VECTOR -"C+200 /CURVE COMMAND CURVE -"T+200 /TEXT COMMAND RTEXT /(TEXT IS A PSEUDO OP FOR PAL) -"W+200 /PERMANENT WRITING OPTIONS WRITE -"S+200 /SCREEN COMMANDS SCREEN -"R+200 /REPORT COMMAND REPORT -"L+200 /LOAD CHARACTER CELL COMMAND LDCHAR 0 /TERMINATOR. THATS ALL THERE IS AT THIS LEVEL CURTAB, -"[+200 CURBKT -"(+200 COPT 0 COPTBL, -")+200 CURVEX -"B+200 /SAVE CURRENT POSTION BOUCUR -"C+200 CURVEC -"S+200 /SAVE DUMMY POSTION UNBCUR -"E+200 /MOVE TO LAST SAVED POSITION ENDCUR -"A+200 CURARC -"W+200 TMPOPT 0 MACTAB, -".+200 /MACROGRAPH FUNCTION CLRGRP /CLEAR ALL MACROGRAPHS -":+200 /DEFINE A MACROGRAPH DEFGRP 0 POSTAB, -"[+200 PBKT -"0+200 /MOVE IN THIS DIRECTION (+0 DEG) PV0 -"1+200 PV1 /MOVE IN THIS DIRECTION (+45 DEG) -"2+200 PV2 /MOVE IN THIS DIRECTION (+90 DEG) -"3+200 PV3 /MOVE IN THIS DIRECTION (+135 DEG) -"4+200 PV4 /MOVE IN THIS DIRECTION (+180 DEG) -"5+200 PV5 /MOVE IN THIS DIRECTION (+225 OR -135 DEG) -"6+200 PV6 /MOVE IN THIS DIRECTION (+270 OR -90 DEG) -"7+200 PV7 /MOVE IN THIS DIRECTION (+315 OR -45 DEG) -"(+200 POPT 0 / /POSITION OPTIONS AVAILABLE - (, ), B, S, E, W, ', " / POPTBL, -")+200 POSITX -"B+200 /SAVE CURRENT POSTION SAVPOS -"S+200 /SAVE DUMMY POSTION SAVDUM -"E+200 /MOVE TO LAST SAVED POSITION LASPOS -"W+200 TMPOPT 0 REPTAB, -"(+200 REPOPT 0 REPTBL, -"=+200 ROPP /REPORT MACRO-GRAPH STORAGE -"P+200 ROPP /REPORT CURSOR POSITION -"E+200 ROPE /REPORT ANY ERRORS -")+200 REPEXI /EXIT REPORT 0 SCRTAB, -"(+200 SCROPT 0 SHTAB, -"(+200 SOHO -")+200 SOPHEX -"P+200 SOPHP -"[+200 SHBRKT 0 SOHOPT, -"P+200 SOPHP -")+200 SOHOEX 0 SOPTBL, -")+200 SCREEX -"C+200 /CURSOR ON/OFF FUNCTION SOPC -"E+200 /ERASE FUNCTION SOPE -"A+200 /ADDRESS FUNCTION SOPA -"I+200 /SET BACKGROUND COLOR SOPI -"H+200 /REQUEST FOR SCREEN DUMP SOPH -"M+200 SOPM -"T+200 /REQUEST THE TIME TO WAIT SOPT 0 /TERMINATOR. THAT'S ALL THERE IS AT THIS LEVEL. TXTTAB, -"'+200 TYTEXS -""+200 TYTEXS -"(+200 TEXOPT -"[+200 TBKT // -",+200 // DUMMY -"0+200 /MOVE IN THIS DIRECTION (+0 DEG) TPV -"1+200 TPV /MOVE IN THIS DIRECTION (+45 DEG) -"2+200 TPV /MOVE IN THIS DIRECTION (+90 DEG) -"3+200 TPV /MOVE IN THIS DIRECTION (+135 DEG) -"4+200 TPV /MOVE IN THIS DIRECTION (+180 DEG) -"5+200 TPV /MOVE IN THIS DIRECTION (+225 OR -135 DEG) -"6+200 TPV /MOVE IN THIS DIRECTION (+270 OR -90 DEG) -"7+200 TPV /MOVE IN THIS DIRECTION (+315 OR -45 DEG) 0 TOPTBL, -"S+200 TOPS -"H+200 TOPH -"U+200 TOPU -"M+200 TOPM -"D+200 TOPD -"I+200 TOPI -"A+200 TOPA -"B+200 TOPB -"E+200 TOPE -"W+200 TMPOPT -")+200 TEXOPX 0 VECTAB, -"[+200 PBKT -"0+200 /MOVE IN THIS DIRECTION (+0 DEG) PV0 -"1+200 PV1 /MOVE IN THIS DIRECTION (+45 DEG) -"2+200 PV2 /MOVE IN THIS DIRECTION (+90 DEG) -"3+200 PV3 /MOVE IN THIS DIRECTION (+135 DEG) -"4+200 PV4 /MOVE IN THIS DIRECTION (+180 DEG) -"5+200 PV5 /MOVE IN THIS DIRECTION (+225 OR -135 DEG) -"6+200 PV6 /MOVE IN THIS DIRECTION (+270 OR -90 DEG) -"7+200 PV7 /MOVE IN THIS DIRECTION (+315 OR -45 DEG) -"(+200 VOPT 0 / /VECTOR OPTIONS AVAILABLE - (, ), B, S, E, W, ', " / VOPTBL, -")+200 VECTOX -"B+200 /SAVE CURRENT POSTION SAVPOS -"S+200 /SAVE DUMMY POSTION SAVDUM -"E+200 /MOVE TO LAST SAVED POSITION LASPOS -"W+200 TMPOPT 0 WRTTAB, -"(+200 WRTOPT 0 WRTTBL, -"I+200 /SET FOREGROND COLOR COMMAND WOPI -"C+200 WOPC -"E+200 WOPE -"R+200 WOPR -"V+200 WOPV // -"F+200 /NOT USED DUE TO HARDWARE LIMITATIONS..... // WOPF -"M+200 WOPM -"N+200 WOPN -"S+200 WOPS -"P+200 WOPP -")+200 WRITEX 0 /WRITE FUNCTION WOPSTB, -"[+200 WOPSLB -"'+200 WOPSQT -""+200 WOPSQT 0 / CLRTB1, -"(+200 GETCOP 0 /TERMINATOR CLRTB2, 1 -"B+200 -"R+200 -"M+200 -"G+200 -"C+200 -"Y+200 -"W+200 -"D+200 0 /TERMINATOR CLRTB3, -")+200 CLRRP -"H+200 CLRH -"L+200 CLRL -"S+200 CLRS 0 / / MORE TABLES / LOADTB, -"(+200; LDCOPT -""+200; LDCCOD -"'+200; LDCCOD -";+200; LDCEND -",+200; LDCOMM 0000 / LDOPTB, -"A+200; LDCALP -")+200; LDOPEN -";+200; LDCABO ///// -"E+200; LDCEXT (HANDLE ALPHABET EXTENT LATER, IF AT ALL) 0000 TABLEB, 1; 3; 2; 6; 4; 5 / MSTACK, ZBLOCK 33 CMAPTB, 0; 11; 12; 14; 13; 15; 16; 17 10; 1; 2; 4; 3; 5; 6; 7 MACBUF, ZBLOCK 66 PAGE / /SCAN THE MACRO BUFFER FOR A TERMINATOR. EXIT CALL +1 IF TERMINATOR FOUND ELSE /CALL +2 FOR NEXT READ / SCNBUF, 0 JMS IOPEN /SET UP FOR THE READ. SCNBF2, JMS GETMAC /PROCESS UNTIL TERMINATOR SEEN JMP SCNBF1 /END FOUND. CLA JMP SCNBF2 SCNBF1, JMS GETMAC /GET MACRO GRAPH NUMBER NOP CIA /NEGATE IT JMS GT2END /LOOK FOR THE FINAL VALUE CLA JMP I SCNBUF / /CLEAR ALL MACRO GRAPHS / CLRGRP, 0 RDF TAD (CIF CDF DCA CLRGR9 CIF CDF TBLFLD TAD (-32 /INIT THE FILL COUNTER. DCA 10 /USE AN AUTO INDEX AS A TEMPORARY TAD (MSTACK-1 /SET UP BUFFER ADDRESS DCA 11 DCA I 11 /NOW THE ACTUAL CLEAR LOOP ISZ 10 /UPDATE COUNTER JMP .-2 /STAY IN THE LOOP TILL DONE. TAD (-27 /AMOUNT OF FREE SPACE WHEN THE STATCK IS FILLED DCA I 11 JMS STTAB /RESTORE THE NEW TABLE PR3 4000+MCFLD+TABFLD /MARK THE END OF THE TABLE ZZERO+1 33 -1 -1 DCA MACSTK CLRGR9, HLT JMP I CLRGRP /EXIT. THE MACRO GRAPHS HAVE BEEN INITIALIZED. / /UPER - MAKE UPPER CASE ROUTINE (SAME CODE AS "UPPER" IN REGFLG / UPER, 0 / DCA UPETM /SAVE CHAR TAD UPETM TAD (-141 /LOWER CASE A TO Z SPA /SKIP IF IT STILL LOOKS GOOD JMP UPER8 /NOT LOWER CASE TAD (-32 /THE RANGE OF CHARACTERS SMA CLA /SKIP IF WITHIN RANGE JMP UPER8 /NOT LOWER CASE CHARACTER TAD UPETM /MAKE IT UPPERCASE TAD (-40 /THIS DOES IT DCA UPETM /SAVE FOR RETURN / UPER8, CLA CLL TAD UPETM /GET CONVERTED CHAR JMP I UPER /RETURN WITH CHAR, NOW UPPER-CASE / IOPEN, 0 DCA GETM1 /BUFFER ADDRESS TO START READ STA DCA MACCNT JMP I IOPEN / CLRMAP, 0 TAD (MSTACK-1 DCA 10 TAD (-33 DCA 11 DCA I 10 ISZ 11 JMP .-2 JMP I CLRMAP / LASACT, 0 MACACT, 0 /MACRO ACTIVE FLAG MACCNT, 0 UPETM, 0 ZZERO, -1; 0; 0; 0 PAGE / / /VT125 MACRO GRAPH HANDLER ROUTINES. / /THE FOLLOWING ROUTINES WILL PERFORM THE FOLLOWING FUNCTIONS: / / @. SAYS TO CLEAR THE MACRO GRAPHS / @: A-Z @; DEFINE A MACROGRAPH. / / A TABLE OF 27 WORDS IS RESERVED IN PANEL MEMORY FIELD 4 / AT ADDRESS ZERO FOR THE TABLE POINTER FOR THE MACRO GRAPHS. / THE TABLE CONSISTS OF A POINTER TO THE START OF THE MACRO / GRAPH BEING USED. AND WORD 27 CONTAINS THE AMOUNT OF FREE SPACE LEFT / MINUS THE NUMBER OF UNUSED CHARACTER DESIGNATORS. / A MACROGRAPH IS N-1 CHARACTERS WITH THE LAST WORD CONTAINING THE / NEGATIVE VALUE OF THE MACRO GRAPH MINUS THE ASCII CODE FOR "A" / SO THAT MACRO GRAPH A WILL BE "-1" INTERNALLY. THIS IS USED TO / TERMINATE THE MACRO GRAPH AND AND TO DETERMINE WHAT GRAPH IS BEING / MANIPULATED DURING THE PURGE PROCESS. / / A 27 WORD AREA IS RESERVED FOR A MACRO GRAPH STORAGE AREA IN MAIN / MEMORY TO KEEP TRACK OF WHICH MACRO GRAPHS ARE ACTIVE AT ANY ONE / TIME. IN ADDITION A 32 WORD AREA IS NEEDED TO STORE MACRO GRAPHS / BEING EXECUTED. / / MACSTK = CURRENT ENTRY INTO THE MACROGRAPH TABLE. THIS / POINT TO THE CURRENT ACTIVE ENTRY IN THE MACROGRAPH. / / MSTACK = 27 WORD MACRO STORAGE AREA. / MACCUR = CURRENT ENTRY IN THE MACRO BEING USED / MACPNT = CURRENT POINT IN THE 32 WORD MACRO STORAGE AREA. / MACCNT = CURRENT NEGATIVE VALUE IN THE BUFFER AREA. THIS IS / = USED TO DETERMINE WHEN DATA HAS TO BE STORED OR / RETRIEVE FROM PANEL MEMORY. / MSTART = CURRENT STYARTING ADDRESS OF THE MACRO GRAPH. / / THE MACRO GRAPH DEFINITIONS ARE TERMINATED BY A ZERO ENTRY IN THE / MACRO GRAPH STORAGE AREA IN CONTROL PANEL MEMORY. / / /DEFINE A MACRO GRAPH. THIS ROUTINE DEFINES A MACRO GRAPH AS DEFINED /BY THE CHARACTER FOLLOWING THE INTRODUCER. CHARACTERS FROM A TO Z ARE ALLOWED /WITH LOWER CASE TO UPPER CASE CONVERSION DONE. THE ROUTINE WILL FIRST /PURGE THE EXISTING MACRO GRAPH LIBRARY IN THE EVENT THE GRAPH IS BEING /REDEFINED. CURRENTLY THERE IS NO METHOD FOR DELETING A MACRO GRAPH ONLY IN /MAKING A NULL GRAPH WHICH CAUSES NO ACTION. / DEFTMP, 0 /TEMP REQUIRED MACSTK, 0 DEFGRP, 0 /DEFINE A MACRO GRAPH. STA /TELL MAIN LEVEL TO PASS ALL CDF RGFLD DCA I (SEMIOK STA DCA I (LOACTV CDF TBLFLD DEFGR6, CIF RGFLD JMS CURLEV /ESTABLISH THIS LEVEL OF PROCESSING CDF TBLFLD /ESTABLISH THIS FIELD FOR RETURN DCA CHAR TAD CHAR JMS UPER /MAKE UPPER CASE DCA CHAR /THIS WILL MAKE IT UPPER CASE ONLY DEFGR1, CLA /MAKE SURE AC IS CLEARED AS IT MAY NOT /BE FROM A PREVIOUS CONDITION TAD CHAR /NOW SEE IF IT IS A VALID CHRACTER TAD (-101 /A-Z ALLOWED SPA /SKIP IF IT A LETTER JMP DEFEXT /ERROR EXIT. THE CHARACTER WAS NOT IN THE /DESIRED RANGE OF CHARCTERS TAD (-32 /THE HIGH END SMA CLA /SKIP IF VALID CHARACTER JMP DEFEXT /ERROR EXIT. PR3 /GET THE CURRENT DEFINITIONS 5000+TBLFLD+MACFLD /FROM USER TO CP 0 /ADDRESS 0 MSTACK -33 /FOR THIRTY THREE WORDS -1 /TERMINATION TAD CHAR TAD (-101 /MAKE THE GRAPH OFFSET. DCA MACSTK /SAVE THE CURRENT VALUE TAD (MSTACK /BUFFER ADDRESS TAD MACSTK /CURRENT OFFSET DCA MSTART /CURRENT POINTER TAD I MSTART /NOW DETERMINE IF MACRO IS ACTIVE. (NON-ZERO) SZA /SKIP IF NOT JMS PURGE /GO PURGE THE MACRO GRAPHS TO GET AS MUCH SPACE /AS POSSIBLE. THIS ROUTINE IS EXECUTED ONLY IF /THE MACRO IS TO BE REDEFINED. JMS FNDFRE /FIND THE FIRST AVAILABLE FREE SPACE. DCA MSTART /SAVE THE STARTING ADDRESS. TAD MSTART /WORD TO START AT JMS OUSETP /SET UP OUTPUT ROUTINE DEFGR2, CIF RGFLD JMS CURLEV /CURRENT ENTRY FROM INPUT ROUTINE CDF TBLFLD /ESTABLISH THIS FIELD FOR RETURN DCA CHAR TAD CHAR TAD (-100 /LOOK FOR AN "@" SZA CLA /SKIP IF YES. GO LOOKAHEAD AT THE NEXT CHARCTER /TO SEE IF IT IS A TERMINATOR. JMP DEFGR3 /NOT AN INTRODUCER CIF RGFLD JMS CURLEV /MAKE THIS THE NEXT LEVEL CDF TBLFLD /ESTABLISH THIS FIELD FOR RETURN DCA CHAR TAD CHAR TAD (-";+200 /LOOK FOR A SEMI COLON TO TERMINATE THE LOOP SZA CLA /SKIP IF TERMINAL CHARACTER JMP DEFGR4 /NOT A TERMINAL CHARACTER. GO TEST FOR AN /ERROR CONDITION TAD FULL /SEE IF MACRO GRAPHS ARE FULL SZA CLA /NON-ZERO SAYS IT IS DCA MACCUR /SET UP TO NULL THE GRAPH JMS NULLGR DEFEXT, CLA /ERROR EXIT AT THIS POINT CIF CDF RGFLD DCA I (SEMIOK DCA I (LOACTV CDF TBLFLD DCA FULL DCA MACACT /CLEAR MACRO ACTIVE FLAG DCA MACSTK /MAKE SURE THE STACK LEVEL IS CLEARED JMP I DEFGRP /EXIT THE ROUTINE DEFGR4, TAD CHAR /LOOK TO SEE IF A REDEFINITION IS BEING ASKED TAD (-":+200 SZA CLA /SKIP IF YES JMP DEFGR5 /STORE THE PROPER CHARACTERS JMS CLRCUR /CLEAR THE CURRENT ONE BEING DONE AND RESTART /THE MACRO GRAPH DEFINITION AS A MACRO GRAPH /CANNOT DEFINE ANOTHER MACRO GRAPH. JMP DEFGR6 /GO BACK AND TRY AGAIN /********************************************************************** /NEED TO HANDLE THE CLEAR MACRO GRAPH CONDITION /AS THE MACRO GRAPH DO NOT GET CLEARED UNTIL /IT IS TERMINATED. /********************************************************************** DEFGR5, CLL CLA IAC BSW /AC=100 JMS STMAC /STORE A MACRO CHARACTER DEFGR3, TAD CHAR /STORE THE INCOMING CHARACTER JMS STMAC /DO IT. JMP DEFGR2 /GO BACK AND GET ANOTHER. / /NULLGR - ROUTINE TO NULL THE MARCO'S / NULLGR, 0 RDF TAD (CIF CDF DCA NULRTN CIF CDF TBLFLD TAD MACSTK /GET TERMINATOR VALUE CMA /MAKE THE TERMINATOR JMS OCLOSE /TERMINATE THE FUNCTION TAD MACSTK /NOW SET UP TO RESTORE THE TABLE TAD (MSTACK /MAKE THE POINTER DCA DEFTMP TAD MSTART /STARTING ADDRESS FOR THE MACRO DCA I DEFTMP JMS FNDFRE /FIND THE FIRST FREE SPOT CIA /MAKE THE NUMBER OF FREE WORDS DCA MSTACK+32 /SAVE IT. PR3 4000+MCFLD+TABFLD MSTACK 0 -33 -1 /WRITE OUT THE NEW MACRO TABLE. NULRTN, HLT JMP I NULLGR /RETURN PAGE / /STORE A CHARACTER INTO AN OUTPUT BUFFER AND IF FULL SEND IT TO THE /PANEL RAM ADDRESS SEPCIFIED BY MACCUR. A 32 WORD TRANSFER IS DONE /UNLESS A TERMINATOR IS SEEN IN WHICH CASE THE REMAINING PART OF THE /BUFFER IS SENT. /IF MACCUR IS ZERO THEN THE POINTERS ARE TO BE RESET. / STMAC5, 0 STMAC, 0 DCA STMAC2 /SAVE THE CHARACTER TO DO TAD FULL /TEST TO SEE IF OUTPUT INHIBITED SZA CLA /SKIP IF NOT JMP I STMAC /TAKE THE EXIT. TAD STMAC2 JMS PACK /DO THE PROPER PACKING STMAC6, CLL CLA IAC R3L /(AC=10)SEE IF AT THE END OF THE BUFFER TAD STMAC5 /GET THE POSITIVE VALUE IAC /DOUBLE WORD OFFSET CLL RAL /*2 FOR FINAL RESULT TAD STMAC4 /NOW THE CURRENT BUFFER ADDRESS SZA CLA /SKIPS IF NO ROOM AVAILABLE JMP I STMAC /EXIT STA /MARK THE MACRO STORAGE AS FULL DCA FULL /MARK IT AS NOT AVAILABLE JMP I STMAC /JUST EXIT. DON'T UPDATE COUNTERS OR POINTERS /AS THERE IS NOT ENOUGH ROOM. / /OS8 PACKING ROUTINE. / PACK, 0 DCA STMAC2 ISZ OUJMP /BUMP UNPACK SWITCH OUJMP, HLT /MODIFIED FOR PACKING SWITCH JMP OCHAR1 JMP OCHAR2 TAD OUJMPE DCA OUJMP /RESET UNPACK SWITCH TAD STMAC2 /THIRD CHARACTER PACKING CLL RTL RTL AND (7400 /MASK OFF TO THE PROPER BITS TAD I OUPOLD /GET BACK THE CHARACTER PREVIOUSLY STORED DCA I OUPOLD /AND RESTORE IT TAD STMAC2 /NOW FOR THE SECOND HALF OF IT CLL RTR /THE SECOND DOUBLE WORD GETS THE LOW ORDER /BITS OF THE THIRD WORD. RTR RAR AND (7400 /MASK TO THE NEEDED FOUR BITS TAD I MACCUR /OUTPUT POINTER. DCA I MACCUR /TO THE BUFFER ISZ MACCUR /UPDATE BUFFER ADDRESS ISZ STMAC5 /SEE IF READY TO WRITE. JMP OUCOMN /TAKE THE NORMAL EXIT. TAD (-20 /SET UP TO DO THE WRITE TO PANEL.(16 WORDS) JMS PRWRT /DO THE WRITE TO PANEL MEMORY JMS OUSETP /RESET THE BUFFERS AND STUFF JMP I PACK OCHAR2, TAD MACCUR /POINT TO FIRST DOUBLE WORD. DCA OUPOLD ISZ MACCUR OCHAR1, TAD STMAC2 /GET BACK THE CHARACTER DCA I MACCUR /STORE THE CHARACTER OUCOMN, ISZ BYTCNT /SET UP FOR CLOSE JMP I PACK /EXIT CLL CLA CMA RTL /AC=-3 DCA BYTCNT /RESET PACKING SWTICH. JMP I PACK OUPOLD, 0 STMAC2, 0 FULL, 0 BYTCNT, 0 PURTMP, 0 PURCNT, 0 OUJMPE, JMP OUJMP /PACKING SWITCH. / /PURGE THE CURRENT MACRO GRAPH LIBRARY AS A REDEFINTION HAS BEEN REQUESTED. / PURGE, 0 DCA PURTMP /SAVE THE CURRENT POINTER. DCA I MSTART /CLEAR THE CURRENT ACTIVE POINTER TAD PURTMP /CURRENT STARTING ADDRESS DCA MSTART /SAVE IT FOR STORAGE ROUTINE TAD MSTART JMS CLEAR1 TAD PURTMP /BUFFER ADDRESS TO AC JMS SCNBUF /SCAN THE BUFFER FOR A TERMINATOR PURG3, TAD INPTR /CALCULATE THE STARTING ADDRESS TAD (-MBUF1 TAD RDTEMP /NOW CALCULATE THE ADDRESS. DCA PURTMP /AND SAVE IT TAD MSTART /OPEN UP THE OUTPUT AREA JMS OUSETP /SET UP OUTPUT BUFFER STUFF. TAD PURTMP /BUFFER ADDRESS TO AC JMS IOPEN /SET TO READ PURG4A, JMS GETMAC /GET A CHARACTER FROM THE MACRO BUFFER SKP JMP PURG4B JMS GETMAC NOP CIA /GET THE MACRO GRAPH NUMBER JMS GT2END /GET TO THE END OF THE GRAPH AS IT MAY NOT BE /ON A 2 WORD BOUNDRY PURG4B, SPA /SKIP IF NOT THE END JMP PURG5 /GO TERMINATE THE MACRO SNA /SKIP IF ALL DONE JMP I PURGE /AND EXIT JMS STMAC /STORE THE MACRO CHARACTER JMP PURG4A /TRY NEXT BUFFER PURG5, DCA PURCNT /SAVE THE TERMINATOR TAD PURCNT /NOW TERMINATE THE BUFFER JMS OCLOSE /DO IT TO IT TAD PURCNT CMA /MAKE IT POSITIVE. TAD (MSTACK /TABLE POINTER FOR MACRO ENTRIES DCA PURCNT TAD MSTART /GET THE CURRENT STARTING POINT DCA I PURCNT /AND MARK THE STARTING POINT OF THE MACRO. TAD STMAC9 /GET THE END OF THE BUFFER CMA TAD STMAC4 /THE BUFFER ADDRESS TAD (-20 /TO OFFSET THE BUFFER UPDATE AT STMAC DCA MSTART /AND RESET THE OUTPUT BUFFER JMP PURG3 / PAGE / /READ A 64 WORD OF MACRO GRAPH AREA INTO THE BUFFER. / RDTMP1, 0 / RDGRPH, 0 DCA RDTEMP /SAVE THE BUFFER ADDRESS DCA RDTMP1 ISZ RDTMP1 JMP .-1 PR3 /FIND THE FIRST TERMINATOR AS IT HAS TO BE /SKIPPED OVER. 5000+TBLFLD+MACFLD RDTEMP, 0 MBUF1 /BUFFER -20 /FOR 16 WORDS -1 /TERMINATOR JMP I RDGRPH /EXIT. / /ROUTINE TO FIND THE FIRST AVAILABLE FREE SLOT IN MACRO GRAPH STORAGE AREA. /A ZERO TERMINATES THE MACRO GRAPH BUFFER AREA IN CP MEMORY. / FNDFR1, 0 FNDFRE, 0 TAD (33 /SET UP THE PRQ FOR THE TRANSFER DCA FNDFR1 /AND SAVE IT. (IT GETS MODIFIED AS THINGS /GO ALONG.) FNDFR4, TAD FNDFR1 /BUFFER ADDRESS TO START AT JMS RDGRPH /READ BUFFER TAD (-20 /BUFFER COUNTER DCA FNDTMP /CLEAR A COUNTER TAD (MBUF1-1 /NOW SCAN THE BUFFER DCA 10 /USE AN AUTO INDEX REGISTER FNDFR3, TAD I 10 /GET A VALUE SNA CLA /SKIP IF NOT AT THE END JMP FNDFR2 /AT THE END. FIND THE ACTUAL POINTER. ISZ FNDTMP /UPDATE THE COUNTER JMP FNDFR3 /GO BACK AND TRY AGAIN TAD (20 /16 WORDS TAD FNDFR1 DCA FNDFR1 /SAVE IT JMP FNDFR4 /TRY ANOTHER BUFFER. FNDFR2, TAD (20 /16 WORDS TAD FNDTMP /CURRENT VALUE TAD FNDFR1 /NOW MAKE THE FINAL VALUE JMP I FNDFRE /AND EXIT WITH THE VALUE IN THE AC. FNDTMP, 0 /TEMP WORK AREA / /CLEAR THE CURRENT MACRO DEFINITION AS A DEFINITION IS TRYING TO /BE DONE FROM WITH A DEFINITION. / CLRCUR, 0 TAD MACSTK /GET THE CURRENT MACRO TAD (MSTACK /THE ADDRESS OF THE POINTER DCA CLRTMP /SAVE THE POINTER DCA I CLRTMP /CLEAR THE CURRENT VALUE PR3 /NOW WRITE BACK THE EXISTING STUFF. 4000+MCFLD+TABFLD /FROM FIELD 4 TO FIELD 4 0 MSTACK /FROM THIS ADDRESS -33 /FOR 27 WORDS -1 /TERMINATOR TAD MSTART /CLEAR OUT THE ENTRY JMS CLEAR1 JMP I CLRCUR /CLEAR THE CURRENT VALUE CLRTMP, 0 / /GET A CHARACTER FOR THE DESIRED MACRO. /IF THE AC IS NON-ZERO AT ENTRY A NEW READ IS FORCED TO GET THE GRAPH /GRAPH STARTED. EXT CALL +1 IF A TERMINATOR SEEN AND CALL PLUS 2 IF NOT. / INJMPE, JMP INJMP INCTLW, 0 INPTR, 0 GETMAC, 0 GETM3, ISZ INJMP /UNPACKING SWITCH ISZ MACCNT /UPDATE THE COUNTER TO SEE IF NEXT READ TO BE /DONE. JMP INJMP /NOT YES GO GET A CHARACTER TAD (MBUF1 /READ BUFFER DCA INPTR /SET UP THE STARTING OUTPUT POINTER. TAD (-31 /THIS NUMBER OF WORDS(16*3/2) DCA MACCNT TAD GETM1 /GET THE BUFFER TO READ JMS RDGRPH /GO READ IT AND PUT IT IN MBUF1. TAD (20 /FOR THE UPDATE TAD GETM1 DCA GETM1 /SAVE THE NEW BUFFER ADDRESS. TAD INJMPE DCA INJMP JMP GETM3 /GO PROCESS THE BUFFER INJMP, HLT /MODIFIED TO JUMP TO THE PROPER PLACE JMP ICHAR1 JMP ICHAR2 TAD INJMPE DCA INJMP TAD I INPTR /GET A CHARACTER AND (7400 /MASK OFF CLL RTR RTR ISZ INPTR TAD INCTLW /PREVIOUS FOUR BITS RTR RTR JMP INCOMN /NORMAL EXIT ICHAR2, TAD I INPTR /SECOND CHARACTER AND (7400 /MASK OFF DCA INCTLW /SAVE IT FOR NOW ISZ INPTR ICHAR1, TAD I INPTR /GET THE CHARACTER INCOMN, AND (377 /MASK TO 8 BITS TAD (-377 /LOOK FOR THE TERMINATOR SNA /SKIP IF NOT DONE JMP I GETMAC /ERROR EXIT. TERMINATOR SEEN TAD (377 /RESTORE THE CHARACTER ISZ GETMAC /UPDATE RETURN FOR COMPLETION ON THIS GRAPH JMP I GETMAC GETM1, 0 /BUFFER ADDRESS FOR A READ. / PAGE / /A REQUEST HAS BEEN MADE TO PROCESS A MACRO GRAPH. /FIRST A TEST IS DONE TO SEE IF THE MACRO GRAPH IS ACTIVE IF IT IS THIS IS /AN ERROR CONDITION AND RETURN TO THE CALLER IS MADE WITH NO PROCESSING. NEXT /THE GRAPH STARTING ADDRESS IS FOUND. IF THERE IS NO GRAPH DEFINED THEN AGAIN /IT IS AN ERROR AND RETURN IS MADE TO THE USER. ONE THE GRAPH HAS BEEN VALIDATED /AS BEING VALID A TEST IS DONE TO SEE IF THERE ARE ANY ENTRIES ACTIVE. IF /THERE ARE NO ENTRIES THEN THE CALLING FIELD AND RETURN ADRRES FOR REGIS ARE /SAVE SO THAT THE MACRO PROCESSOR CAN CALL REGIS. ALL PROCESSING CONTINUES UNTIL /ALL GRAPHS HAVE BEEN PROCESSED AND THE STACK LEVEL RETURNS TO ZERO AT WHICH /TIME THE REGIS RETURN FIELD AND ADDRESS ARE RESTORED. /(ONE NOTE. THE STACK IS A MAXIMUM OF 26 WORDS AS THAT IS ALL THE LETTERS THAT /ARE ALLOWED IN THE ALPHABET.) / DOGR2, 0 DOGR3, 0 DOGRPH, DCA CHAR CDF TBLFLD TAD LASACT /RESTORE THE CURRENT LEVEL CDF RGFLD /ESTABLISH THIS FIELD FOR RETURN DCA I (CURLEV /TERMINATE THE ACTIVITY AS THIS IS THE SAME /AS NORMAL INPUT. CDF TBLFLD /ESTABLISH THIS FIELD FOR RETURN TAD MACSTK /SEE IF FLAG BUFFER NEEDS TO BE SET UP. SNA CLA /SKIP IF NOT JMS CLRMAP TAD CHAR /GET THE CHARACTER TO PROCESS TAD (-101 /OFFSET INTO ACTIVE TABLE DCA DOGR5 /SAVE THE TABLE ADDRESS FOR LATER. TAD DOGR5 /NOW CALCULATE THE ACTIVE BUFFER ADDRESS TAD (MSTACK /USE THIS STACK. DCA DOGR4 /SAVE IT TAD I DOGR4 /GET THE ADDRESS OF THE ENTRY TO SEE IF THIS /MACRO GRAPH IS BEING USED. SZA CLA /A ZERO SAYS IT IS NOT ACTIVE AND WE CAN CONTINUE JMP DOGR9 /EXIT ROUTINE. NO SENSE IS DOING THIS AS /RECURSION IS NOT SUPPORTED. PR3 5000+TBLFLD+MACFLD /READ FROM PANEL DOGR5, 0 /MODIFIED TO ADDRESS TO READ IN PANEL DOGR4, 0 /MODIFIED TO ADDRESS TO WRITE TO IN MAIN -1 /FOR ONE WORD -1 /TERMINATOR. TAD I DOGR4 /NOW SEE IF THERE IS A MACRO DEFINED. SNA CLA /SKIP IF YES. JMP DOGR9 /EXIT. THERE IS NO GRAPH TO DO. / /NOW TEST TO SEE IF RETURN ADDRESSES HAVE TO BE SAVED. / TAD MACSTK /IF ZERO THEN SAVE REGIS RETURN SZA CLA /SKIP IF INIT TO BE DONE. JMP DOGR1 /ALREADY ACTIVE. DON'T SAVE IT AGAIN ISZ MACSTK /MARK THE FIRST ENTRY LEVEL CDF RGFLD TAD I (REGIS /SAVE THE CURRENT REGIS RETURN DATA DCA DOGR2 TAD I (REGRET+2 /AND THE RETURN FIELD STUFF. DCA DOGR3 /SAVE IT. CDF TBLFLD JMP DOGR1B /GO OPEN UP THE INPUT AREA DOGR1, TAD MACSTK /NOW STORE THE CURRENT POINTER FOR LATER USE CLL RAL /*2 FOR OFFSET TO TABLE POINTER ISZ MACSTK /UPDATE THE ENTRY LEVEL TAD (MACBUF-1 / DCA DOGR5 /SAVE THE POINTER TAD RDTEMP /CURRENT READ ADDRESS CDF TBLFLD /BUFFER FIELD DCA I DOGR5 /SAVE THE POINTER ISZ DOGR5 /POINT TO THE BYTE VALUE POINTER TAD MACCNT /CURRENT NEGATIVE OFFSET DCA I DOGR5 CDF TBLFLD /HOME FIELD. DOGR1B, TAD I DOGR4 /GET THE BUFFER ADDRESS JMS IOPEN /SET UP THE INPUT INFORMATION DOGR1A, JMS GETMAC /GO GET A CHARACTER FOR THE MACRO GRAPH. JMP DOGR7 /THIS GRAPH IS DONE. SEE IF ALL DONE THE ENTIRE /SET OF MACROS. CIF RGFLD JMS REGIS /GO SEND THE COMMAND TO REGIS JMP DOGR1A /AND TRY AGAIN. / /AT THIS POINT A TERMINATOR WAS SEEN AND IS IN THE AC. CLEAR THE CURRENT /GRAPH FLAG AND GET THE NEXT ONE IF AVAILABLE. / DOGR7, JMS GETMAC /GET THE MACRO GRAPH NUMBER +1 NOP TAD (-1 TAD (MSTACK /CALCULATE THE POINTER FOR ACTIVITY. DCA DOGR4 / DCA I DOGR4 /CLEAR THIS ENTRY STA TAD MACSTK /GET THE CURERNT POINTER DCA MACSTK /SAVE THE OFFSET TAD MACSTK SPA SNA /SKIP IF NOT EMPTY. JMP DOGR8 /CLEAN UP AND EXIT CLL RAL /*2 FOR BUFFER OFFSET TAD (MACBUF-1 JMS GETTHR /GET TOT THE PROPER POINT IN THE BUFFER JMP DOGR1A /AND TRY AGAIN CONTINUING AT THE LAST POINT /THAT WAS LEFT OFF. DOGR8, CDF RGFLD TAD DOGR2 /NOW RESTORE REGIS LEVEL DCA I (REGIS TAD DOGR3 DCA I (REGRET+2 /AND THE FIELDS DOGR9, CIF RGFLD JMP REGRET /SAME AS "NEXT" BUT MODIFIED FOR THIS FIELD / /POSITION THE POINTERS AT THE PROPER POINT IN THE UNPACKING BUFFER. /ENTER WITH BUFFER POINTER IN THE AC. / GETTHR, 0 DCA DOGR4 /SAVE THE POINTER CDF TBLFLD /TABLE FIELD TAD I DOGR4 DCA DOGR5 /SAVE IT ISZ DOGR4 /NOW THE BYTE COUNT TAD I DOGR4 DCA DOGR4 /SAVE IT FOR LATER. CDF TBLFLD /HOME FIELD AGAIN TAD DOGR5 /STARTING ADDRESS TO AC JMS IOPEN /SET UP THE POINTERS FOR INITIAL READS TAD (31 /NOW GET THE THE SAME CHARACTER YOU LEFT OFF AT TAD DOGR4 CMA DCA DOGR4 /SAVE IT GETHR1, ISZ DOGR4 SKP JMP I GETTHR JMS GETMAC /GET A CHARACTER NOP CLA JMP GETHR1 /STAY IN THE LOOP TILL AT THE PROPER POINT. PAGE /CLEAR A LOCATION IN THE MACRO GRPAH DEFINITION AS DEFINED BY THE AC AT INPUT / CLEAR1, 0 DCA CLR1TM PR3 /NULL THE MACRO IN CASE IT IS LAST IN MEMORY 4000+MCFLD+TABFLD ZZERO+1 CLR1TM, 0 -1 -1 JMP I CLEAR1 / / PRWRT, 0 DCA STMAC9 /SAVE THE NUMBER OF WORDS TO MOVE PR3 /SEND THE DATA 4000+MCFLD+TABFLD MBUF /BUFFER ADDRESS STMAC4, 0 /BUFFER IN CP MEMEORY STMAC9, 0 /WORD COUNT -1 TAD STMAC4 TAD (20 /NEXT AREA TO DO DCA STMAC4 JMP I PRWRT /EXIT. / /TERMINATE A MACRO GRAPH STORAGE / OCLTMP, 0 OCLOSE, 0 CIA /MAKE THE GRAPH NUMBER POSITIVE. DCA OCLTMP /SAVE IT FOR NOW DCA FULL /TERMINATE THE FULL CONDITION TAD (377 /TERMINATOR JMS STMAC /TO THE BUFFER OCLOS1, TAD OCLTMP /GET BACK TERMINATOR VALUE JMS STMAC /TO THE BUFFER CLL CLA IAC CML RAL /AC=3 TAD BYTCNT /SEE IF IT ALL DONE SZA CLA /SKIP IF YES JMP OCLOS1 /NOT YET - TRY AGAIN CLL CLA IAC R3L /SET UP BYTE COUNT TO WRITE TAD STMAC5 CLL RAL /*2 FOR FINAL RESULT IAC /ONE MORE TO COMPENSATE FOR THE TERMINATOR CIA DCA 10 DCA I MACCUR TAD 10 JMS PRWRT /SEND IT JMP I OCLOSE /AND EXIT. OUSETP, 0 SZA /SKIP IF OLD BUFFER TO BE USED DCA STMAC4 /BUFFER STARTING ADDRESS TAD OUJMPE /SET UP PACKING SWITCH DCA OUJMP / TAD (MBUF /BUFFER ADDRESS DCA MACCUR /TO FORCE A RESET TAD (-10 /SET UP DOUBLE WORD COUNTER DCA STMAC5 /SAVE THE COUNT VALUE CLL CLA CMA RTL /AC=-3 DCA BYTCNT /PACKING SWITCH FOR CLOSE JMP I OUSETP /EXIT. / /LOOK FOR THE FINAL GRAPH INDICATOR / GT2END, 0 DCA CLRTM1 /SAVE THE TWO'S COMPLIMENT OF NUMBER SCNBF3, JMS GETMAC /GET THE MACRO GRAPH NUMBER NOP TAD CLRTM1 SNA CLA JMP SCNBF3 TAD CLRTM1 /RETURN CHARACTER IN THE AC JMP I GT2END CLRTM1, 0 STTAB, 0 PR3 /NOW SEND THE DATA TO CP MEMORY 4000+MCFLD+TABFLD /FORM USER TO CP MSTACK /********************************************* 0000 /FORM MSTACK TO 0 OF FIELD FOUR -33 /NUMBER OF WORDS TO MOVE -1 /TERMINATOR JMP I STTAB MBUF, ZBLOCK 22 /WRITE BUFFER REQUIRED - NOW AT 16 CHARACTERS MBUF1, ZBLOCK 20 /READ BUFFER PAGE EJECT / / / / /The following code has been taken out of VT125 module and put into / REGIS for several reasons. First is to take the sixel dump out / of the wpcx WPS modules and put it with the rest of regis. Hopefully / this will lead to an easier conversion process. / I hope to parametize most of the regis and prim modules / to facilitate this conversion.... I am also hoping to list all the / steps necessary to convert the graphics to WPS. Hopefully when / this has been done and I have a full understanding of what I have done / I will list the steps in rgishd.pa and primhd.pa modules. If / the instructions don't get there I forgot to put them in..... / / This module is a dispatch module used to call the SIXEL screen dump, / the reporter, the cursor visibility routine, and the timer. / I'm still not sure what the do at this point but they are / not actually called thru regis but executed in the VT125 GTE module. / this is why they are called directly via a different dispatcher / than REGIS. Hope this is clear. / / THE ROUTINE ACTUALLY CALLED FROM THIS DISPATCH TABLE(RSPNST) HAVE / BEEN TAKEN FROM VT125. CRSVRS REPORT TIMER HARDCP / REPORT IS A DUPLICATE TAG AND MUST BE CHANGED IN THIS AREA SO AS / NOT TO CONFLICT WITH REGIS.. THE LABEL DMYSUB IS ALSO DEFINED IN REGIS / BUT CAN BE DELETED FROM THIS CODE / / GRAPHICS OPTION WORD PASSED TO DISREG FROM CX IN MQ / DISREG,0 /ENTRY..SHOULD BE DEFINED IN WPF1 AND REFERENCED /.......IN WPCX2.PA MODULE..IF ERROR CHECK ADDR. DCA REGRTN /CODE RETURNED TO WPCX FROM REGIS AND PASSED ON RDF /CALLING FIELD TAD (CIF CDF /SET RETURN DCA DISRET /SET DISPATCH RETURN TAD REGRTN SNA CLA /VALID POINTER? 0=NOT A POINTER JMP DISRET /NOT A POINTER.. IGNORE IT CDF RGFLD /POINTER POINTS TO TABLE IN REGIS FLD TAD I REGRTN /GET DATA CDF TBLFLD /MYFLD SMA /ONLY CODES -1, -2, -3, -4 VALID JMP DISRT0 /IGNORE CODE TOO HIGH TAD K0004 /CHECK LIMITS SPA JMP DISRT0 /TOO LOW TAD PRSPNS /ADD BASE ADDRESS OF DISPATCH TABLE DCA KHTMP4 /SAVE AS POINTER TO ROUTINE ADDRESS TAD I KHTMP4 /GET ROUTINE ADDRESS FROM TABLE DCA KHTMP4 /SAVE FOR DISPATCH SWP /GET GRAPHICS OPTION CONTROL WORD DCA OPTION /SET UP AT CX LEVEL(USED ONLY FOR CRSRVS) JMS I KHTMP4 /DISPATCH TO SUBROUTINE / DISRT0, CLA CLL /CLEAR FOR RET DISRET, HLT /SET FIELDS JMP I DISREG /RETURN / / / REGRTN, 0 /DISPATCH CODE POINTER KHTMP4, 0 PRSPNS, RSPNST /REGIS RESPONSE TABLE RSPNST, CRSRVS /-4 --> CURSOR VISIBILITY RPORT1 /-3 --> REPORT TIMER /-2 --> TIMER HARDCP /-1 --> SCREEN DUMP / -------------------------------------------- / RPORT1 - HANDLE REGIS REPORT RESPONSE STRING / -------------------------------------------- / RPORT1, 0 / REPOR2, CLA CLL ISZ REGRTN /INCREMENT THROUGH RESPONSE STRING NOP /(JUST IN CASE) / CDF RGFLD /REGIS FIELD HAS THE STRING TAD I REGRTN /GET A CHARACTER CDF TBLFLD /BACK TO THIS FIELD SPA /CHECK IF TERMINATOR (7777) JMP REPOR6 /YES, GO FINISH UP / JMS I COMCHR /ENQUEUE THIS CHARACTER TO THE HOST / JMP REPOR2 /LOOP UNTIL TERMINATOR SEEN / REPOR6, CLA CLL /END OF STRING, SEND A CR TAD K0015 /GET THE CR CHARACTER JMS I COMCHR /ENQUEUE TO HOST / CLA CLL JMP I RPORT1 /RETURN / / K0004, 0004 K0015, 0015 / /SUBROUTINE TO PUT CHARS TO HOST / COMCHR, XX COMCH1, CIFSYS /SYSTEM IO JMS I KHS2OU /TO COMM JMP NOCNDO /DIDN'T DO IT JMP I COMCHR /DONE NOCNDO, DCA COMSVE /SAVE CHAR CDFSYS TAD I (JWAIT&177 /ADDR. OF JWAIT IN SYSFLD PAGE0 CDF TBLFLD DCA KJWAIT /SET UP JMP(PAGE0 THIS FLD NOT WPS CIFSYS JMS I KJWAIT /WAIT TAD COMSVE /GET CHAR JMP COMCH1 /DO IT / COMSVE, 0 /SAVE CHAR THAT WASN'T OUTPUT KJWAIT, JWAIT /JWAIT KHS2OU, HS2OU /PUT 1 CHAR OUT ON COM LINE / / ------------------------------------- / UNIMPLEMENTED REGIS RESPONSE ROUTINES / ------------------------------------- / TIMER, /SCREEN TIMER /DMYSUB, 0 /DUMMY / CLA CLL JMP I TIMER / ------------------------------- / HARDCP - REGIS HARDCOPY REQUEST / ------------------------------- / HARDCP, 0 / CDF RGFLD /REGIS FIELD FOR HARDCOPY OFFSETS ISZ REGRTN /BUMP POINTER NOP TAD I REGRTN /GET X OFFSET DCA SHPX ISZ REGRTN /BUMP POINTER NOP TAD I REGRTN /GET Y OFFSET DCA SHPY CDF TBLFLD /BACK TO THIS FIELD / JMS I XSCRDM /REQUEST SCREEN DUMP / CLA CLL JMP I HARDCP /RETURN / / XSCRDM, SCRPNT / ---------------------------------------- / CRSRVS - HANDLE SCREEN CURSOR VISIBILITY / ---------------------------------------- / CRSRVS, 0 / CDF RGFLD /REGIS FIELD FOR ON/OFF ISZ REGRTN /BUMP POINTER NOP TAD I REGRTN /GET CURSOR ON/OFF FLAG CDF TBLFLD /BACK TO THIS FIELD / SZA CLA /CHECK IF NON-ZERO AC0001 /SET OR RESET LSB FOR CURSOR VISIBILITY DCA CRSRTM /SAVE FOR LATER MERGE WITH OPTION WORD / TAD K7776 /MASK FOR OPTION WORD (7776 OR 7777) AND OPTION TAD CRSRTM /SET CURSOR VISIBILITY IF NEEDED DCA OPTION / TAD (SETGRP /SET GRAPHICS CONTROL POINTER CIF PRMFLD /PRIM FIELD JMS I (PRIMS /DO IT / JMP I CRSRVS /RETURN / / K7776, 7776 CRSRTM, 0 / SETGRP, CMDSET /SET CURSOR GRAPHICS CONTROL OPTION, 0 / PAGE EJECT / ---------------------------------------- / SCRPNT - SCREEN DUMP WITH SIXEL PROTOCOL / ---------------------------------------- / SCRPNT, 0 / / ------------------------------------------- / SCRDM1 - IDLE LOOP HANDLING FOR SCREEN DUMP / ------------------------------------------- / SCRDM1, / SCRD1A, CLA CLL TAD K0033 /PUT PRINTER IN 'SIXEL MODE' JMS PRCHR / BY SENDING 'ESC P LITTLE-Q' TAD K0120 JMS PRCHR TAD K0161 JMS PRCHR / JMS DOSHPY /HANDLE VERTICAL OFFSETS / DCA RDBITS+2 /RESET Y POSITION TAD (-50 /SET UP Y COUNTER DCA SCRDT5 / SCRDM2, JMS DOSHPX /HANDLE HORIZONTAL OFFSET / DCA RDBITS+1 /RESET X POSITION TAD (-62 /SET UP X COUNTER DCA SCRDT6 / SCRDM4, CLA CLL /? JMS SXLPRO /ENTER HERE FROM IDLE LOOP / CIF PRMFLD /ASK GRAPHICS PRIMITIVES FOR SCREEN DATA TAD PRDBIT JMS PRIM / JMS MAKVIS /DETERMINE WHICH PIXELS SHOW UP AGAINST / THE BACKGROUND / AC7776 /SET UP FOR TWO PASSES THROUGH DISPLAY DCA SCRDT4 / SCRDM6, TAD PWRBIT /POINT TO FOREGROUND DATA FROM GRAPHICS PRIMS DCA SCRDTM / TAD (-6 /SET UP TO TRANSLATE SIX BYTES DCA SCRDT3 / SCRDM8, TAD (-10 /SET UP FOR EIGHT BITS PER BYTE TO XLATE DCA SCRDT2 / TAD PSXLBL /POINT TO SIXEL DATA STORAGE DCA SCRDT1 SCRD10, TAD I SCRDTM /GET A GDC WORD RAR /ROTATE A BIT INTO LINK DCA I SCRDTM /SAVE ROTATED WORD TAD I SCRDT1 /GET SIXEL CHARACTER-IN-PROGRESS RAR /ROTATE BIT FROM SCREEN INTO IT DCA I SCRDT1 /SAVE / ISZ SCRDT1 /POINT OT NEXT SIXEL CHAR ISZ SCRDT2 /INCREMENT THROUGH BITS/CHARS JMP SCRD10 /LOOP / ISZ SCRDTM /POINT TO NEXT GDC WORD ISZ SCRDTM /(TWO TIMES CAUSE INTERDIGITATED) ISZ SCRDT3 /INCREMENT WORD COUNTER JMP SCRDM8 /LOOP / TAD (-10 /SET UP FOR EIGHT SIXEL CHARACTERS DCA SCRDT2 / TAD PSXLBL /POINT TO HALF-FORMED SIXEL CHARS DCA SCRDT1 / SCRD12, /? JMS SXLPRO /BACK TO IDLE LOOP FOR A WHILE /? JMS I XBF16T /CHECK IF ROOM IN BUFFER /? JMP SCRD13 /YES /? NOP /HALF FULL /? JMP SCRD12 /TOO FULL, KEEP CHECKING / SCRD13, CLA CLL TAD I SCRDT1 /GET A CHAR BSW /SWAP INTO LOW SIX BITS FROM HIGH SIX BITS AND (77 /MASK TO SIX BITS TAD (77 /ADD OFFSET TO MAKE A REAL SIXEL DATUM JMS PRCHR /ENQUEUE FOR DISPLAY TO PRINTER / ISZ SCRDT1 /INCREMNT TO NEXT SIXEL CHAR ISZ SCRDT2 /INCREMENT CHAR COUNTER JMP SCRD12 /LOOP / ISZ SCRDT4 /INCREMENT TWO-PASS COUNTER SKP /SKIP IF MORE TO DO JMP SCRD14 /NO MORE TO DO / AC0001 /POINT TO OTHER HALF (INTERDIGITATED) JMP SCRDM6 / OF GDC DATA / SCRD14, TAD (20 /POINT TO NEXT X TAD RDBITS+1 /BY CHANGING CONTROL BLOCK DCA RDBITS+1 / ISZ SCRDT6 /INCREMENT ACROSS SCREEN JMP SCRDM4 /LOOP TAD (55 /SEND A GRAPHICS NEW-LINE TO PRINTER JMS PRCHR / TAD K0014 /POINT TO NEXT Y TAD RDBITS+2 /BY CHANGING CONTROL BLOCK DCA RDBITS+2 / ISZ SCRDT5 /INCREMNT DOWN SCREEN JMP SCRDM2 /LOOP / CLA CLL /? JMS SXLPRO /ENTER HERE FROM IDLE LOOP / CLA CLL TAD K0033 /TAKE PRINTER OUT OF 'SIXEL MODE' JMS PRCHR / BY SENDING AN 'ESC \' TAD K0134 JMS PRCHR / CLA CLL JMP I SCRPNT /RETURN / SHPX, 0 /X OFFSET FOR SCREEN HARDCOPY SHPY, 0 /Y OFFSET FOR SCREEN HARDCOPY SCRDTM, 0 SCRDT1, 0 SCRDT2, 0 SCRDT3, 0 SCRDT4, 0 SCRDT5, 0 SCRDT6, 0 K0014, 0014 K0033, 0033 K0120, 0120 K0161, 0161 K0134, 0134 / PSXLBL, SXLBLK PRDBIT, RDBITS PWRBIT, WRBITS / PAGE / / / -------------------------------------------- / DOSHPY - HANDLE Y OFFSET FOR SCREEN HARDCOPY / -------------------------------------------- / DOSHPY, 0 / DCA DOSHTM /CLEAR COUNTER FOR GRAPHICS NEW-LINES / TAD SHPY /GET NUMBER OF PIXELS TO SKIP VERTICALLY SPA SNA JMP DSHPY6 /NONE REQUESTED / DSHPY2, ISZ DOSHTM /INCREMENT WORKING QUOTIENT / TAD MM0014 /DIVIDE BY TWELVE LOGICAL PIXELS PER NEW-LINE SMA SZA JMP DSHPY2 /LOOP UNTIL DIVIDE COMPLETE / CLA CLL TAD DOSHTM /MAKE NEWLINE COUNTER NEGATIVE FOR LOOP CONTROL CIA DCA DOSHTM / DSHPY4, TAD (55 /SEND A NEWLINE JMS PRCHR ISZ DOSHTM /LOOP UNTIL DOWN FAR ENOUGH JMP DSHPY4 / JMP DSHPY8 /FINISHED WITH NEW LINES / DSHPY6, CLA CLL TAD (44 /NO NEWLINES, ENSURE GRAPHICS RETURN JMS PRCHR / DSHPY8, JMP I DOSHPY /RETURN / / DOSHTM, 0 / -------------------------------------------- / DOSHPX - HANDLE X OFFSET FOR SCREEN HARDCOPY / -------------------------------------------- / DOSHPX, 0 / DCA DOSHTM /CLEAR COUNTER FOR GRAPHICS NULLS / TAD SHPX /GET NUMBER OF PIXELS TO SKIP HORIZONTALLY SPA SNA JMP DSHPX6 /NONE REQUESTED / CIA /MAKE NULL COUNTER NEGATIVE FOR LOOP CONTROL DCA DOSHTM / DSHPX4, TAD (77 /SEND A NULL JMS PRCHR ISZ DOSHTM /LOOP UNTIL OVER FAR ENOUGH JMP DSHPX4 / DSHPX6, CLA CLL JMP I DOSHPX /RETURN MM0014, -0014 / / ------------------------------------------------------------ / MAKVIS - DETERMINE WHICH PIXELS DIFFER FROM BACKGROUND COLOR / ------------------------------------------------------------ / MAKVIS, 0 / CLA CLL TAD M0014 /SET UP COUNTER FOR CLEARING VISIBLE BITS DCA MAKVTM AC7777 TAD PPWRBI /SET UP POINTER TO BLOCK OF VISIBLE PIXELS DCA 14 MAKVI2, DCA I 14 /CLEAR EACH WORD OF PIXELS, NOT YET BUILT ISZ MAKVTM /INCREMENT THROUGH WORDS JMP MAKVI2 /LOOP UNTIL BLOCK IS CLEARED / TAD PPRDB2 /POINT TO STORAGE FOR PRIMITIVE'S PIXELS DCA 15 TAD M0004 /GET COUNT OF PLANES DCA MAKVT1 / MAKVI4, TAD I PRDB63 /GET BACKGROUND COLOR CLL RAR /ROTATE A COLOR SELECTOR BIT INTO LINK DCA I PRDB63 /SAVE MODIFIED BACKGROUND COLOR SZL CLA /CHECK IF THIS PLANE IS ON AC7777 /YES, GET ALL 1S FOR LATER COMPARE DCA MAKVT2 / OR USE ALL 0S IF PLANE NOT ON / TAD PPWRBI /POINT TO BLOCK OF PIXELS BEING BUILT DCA MAKVT5 TAD M0014 /SET UP COUNTER FOR BUILDING THE VISIBLE PIXELS DCA MAKVT3 / MAKVI6, TAD I 15 /GET A BUNCH OF BITS FROM THE PRIMITIVE STORAGE DCA MAKVT4 /SAVE FOR COMPARE WITH THE BACKGROUND COLOR / TAD MAKVT2 /GET MASK OF BACKGROUND COLOR CMA /1S COMPLEMENT AND MAKVT4 /PIXELS .AND. (.NOT. BACKGROUND) MQL /SAVE IN MQ FOR LATER 'OR' TAD MAKVT4 /GET PIXELS CMA /1S COMP AND MAKVT2 /BACKGROUND .AND. (.NOT.PIXELS) MQA /BACKGROUND .XOR. PIXELS MQL /SAVE FOR OR WITH OTHER PLANE'S CONTRIBUTIONS TAD I MAKVT5 /GET A VISIBLE PIXEL WORD MQA /'OR' IN THE LATEST CONTRIBUTION DCA I MAKVT5 /SAVE UNTIL ALL PLANES DONE / ISZ MAKVT5 /INCREMENT POINTER THROUGH BLOCK /(NEVER SKIPS) ISZ MAKVT3 /INCREMENT THROUGH WORDS IN EACH PLANE JMP MAKVI6 /LOOP THROUGH WORDS / ISZ MAKVT1 /INCREMENT THROUGH PLANES JMP MAKVI4 /LOOP THROUGH PLANES / JMP I MAKVIS /RETURN / / MAKVTM, 0 MAKVT1, 0 MAKVT2, 0 MAKVT3, 0 MAKVT4, 0 MAKVT5, 0 PPRDB2, RDBITS+2 M0004, -0004 M0014, -0014 PRDB63, RDBITS+63 PPWRBI, WRBITS /SUBROUTINE TO PRINT CHARS /A050 PRCHR, XX /A050 PRCHR1, CIFSYS /USE SYSTEM I/O /A050 JMS I KLPTOU /CALL IT /A050 JMP UNSUCS /UNSUCCESSFUL /A050 JMP I PRCHR /IT MUST HHAVE ACCEPTED IT /A050 UNSUCS, DCA PRTSVE /SAVE PRINT CHAR CDFSYS TAD I (JWAIT&177 /ADDR. OF JWAIT IN SYSFLD PAGE0 CDF TBLFLD DCA PJWAIT /SET UP JMP(PAGE0 THIS FLD NOT WPS CIFSYS /REGROUP AND TRY AGAIN /A050 JMS I PJWAIT /AFTER WAITING /A050 TAD PRTSVE /GET CHAR THAT WASN'T OUTPUT LAST TIME JMP PRCHR1 /START OVER /A050 / PRTSVE, 0 /CHAR SAVED.. NOT PRINTED AS BUFF FULL KLPTOU, LPOCHR /PRINT A CHAR PJWAIT, PJWAIT /ADDRESS OF JWAIT / PAGE /A050 / RDBITS, 0016 /PRIMITIVE COMMAND TO READ SCREEN 0 /X POSITION 0 /Y POSITION ZBLOCK 60 /RESERVE SPACE FOR RETURN DATA 0 /BACKGROUND COLOR AT LAST SCREEN ERASE /(NOTE BLUE IS LSB, THEN RED, GREEN, INTENSITY) / SXLBLK, ZBLOCK 10 /RESERVE SPACE FOR SIXEL STRING WRBITS, ZBLOCK 14 /BITMAP OF VISIBLE PIXELS PAGE