/ BINARY PATCHES TO FOCAL / LAST EDIT: 15-MAY-1986 18:00:00 CJL / MAY BE ASSEMBLED WITH '/J' SWITCH SET. / THIS FILE IS A ONE-PAGE COLLECTION OF PATCHES TO FOCAL TO IMPLEMENT THREE / FUNCTIONS: / 1): FBLK(BLOCK[,WRITE-INDICATOR]) / 2): FWRD(ADDRESS[,REPLACEMENT VALUE]) / 3): FAND(FIRST-ARGUMENT[,SECOND-ARGUMENT]) / DESCRIPTION OF FUNCTIONS: / FUNCTION "FBLK" READS (OR WRITES) A SET OF DISK BLOCKS STARTING FROM THE / BLOCK NUMBER EVALUATED FROM THE FIRST ARGUMENT. THE FUNCTION WILL CAUSE / A READ OPERATION IF ONE ARGUMENT IS GIVEN; MERELY GIVING A SECOND / ARGUMENT CAUSES A WRITE OPERATION (THE ARGUMENT VALUE IS UNIMPORTANT). / THE MEMORY AFFECTED BY THE TRANSFER IS LOCATION 0000 ONWARD IN FIELD / "BUFFLD." THE NUMBER OF BLOCKS TRANSFERRED IS DETERMINED BY "N." THE / LOGICAL I/O UNIT IS DETERMINED BY "UNIT." / FUNCTION "FWRD" RETURNS THE CONTENTS OF THE SPECIFIED MEMORY ADDRESS / EVALUATED FROM THE FIRST ARGUMENT. IF A SECOND ARGUMENT IS PASSED, THEN / ITS EVALUATION BECOMES THE REPLACEMENT VALUE AT THE SPECIFIED ADDRESS. / THE "FWRD" FUNCTION CAN BE CONDITIONALLY ASSEMBLED TO TREAT THE FIRST / ARGUMENT AS A TWELVE BIT ADDRESS OF A TWELVE BIT NUMBER OR AN ELEVEN BIT / ADDRESS OF A TWENTY-FOUR BIT NUMBER. / FUNCTION "FAND" RETURNS THE LOGICAL BIT-WISE AND OF THE TWO ARGUMENTS / PASSED TO IT. IF THE SECOND ARGUMENT IS NOT PRESENT, IT IS TREATED AS / ZERO AND CAUSES A ZERO RETURN VALUE. / ASSEMBLY INSTRUCTIONS: / SET "ADR" TO 0 FOR 12-BIT ADDRESSING, 1 FOR 24-BIT ADDRESSING (DEFAULT IS 0). / SET "BUFFLD" TO THE PROPER FIELD FOR "FBLK", "FWRD" (DEFAULT IS 40). / SET "N" TO THE I/O CALL LENGTH DESIRED IN "FBLK" (DEFAULT IS 00 WHICH / USES 40 BLOCKS). / SET "UNIT" TO THE DESIRED I/O UNIT (DEFAULT IS 7). / DEFINITIONS FROM FOCAL, 1969 (ORIGINAL PAPER-TAPE VERSION). BOTTOM= 0035 /FOCAL PUSHDOWN LIMIT CHAR= 0066 /FOCAL'S INPUT BUFFER EFUN3I= 0136 /FUNCTION RETURN POINTER EVAL= 1613 /EVALUATOR ENTRY POINT FLAC= 0044 /FLOATING ACCUMULATOR HERE FNTABF= 0374 /FUNCTION ADDRESS TABLE FNTABL= 2165 /HASHED FUNCTION NAME TABLE INTEGER=0053 /FLOATING TO FIXED CONVERSION POINTER POPA= TAD I 13 /REMOVE WORD FROM STACK POPJ= JMP I 141 /REMOVE AND RETURN FROM STACK PUSHA= JMS I 142 /PUSH WORD ONTO STACK PUSHJ= JMS I 140 /CALL WITH RETURN ON STACK P7600= 0104 /CONSTANT 7600 RETURN= JMP I EFUN3I /FUNCTION RETURN INSTRUCTION / DEFINITIONS FROM P?S/8 FOCAL OVERLAY. BEOFZAP=7505 /BINARY LOADER ZAP WORD BONCE= 3600 /OVERLAY ONCE-ONLY ADDRESS SYSIO= 7640 /SYSTEM I/O ENTRY POINT / MISCELLANEOUS DEFINITIONS. IFNDEF ADR /USE 12-BIT ADDRESSING FOR FWRD IFNDEF BUFFLD /BUFFER FIELD FOR FBLK AND FWRD IFNDEF N /DO 40 BLOCK READ/WRITE CALLS FOR FBLK NL4000= CLA CLL CML RAR /SET AC TO 4000 NSTART= -12^ADR+4077 /PATCH ASSEMBLY ADDRESS IFNDEF UNIT /I/O UNIT FOR FBLK FIELD 0 /ENSURE FIELD ZERO *FNTABL+14 /PUT IN HASHED NAMES "B^2+"L^2+"K /BLK "W^2+"R^2+"D /WRD "A^2+"N^2+"D /AND *NSTART /START PATCH HERE FOR DIRECT LOADING / DISK I/O FUNCTION: FBLK(BLOCK[,WRITE-INDICATOR]). XBLK, JMS I INTEGER /GET BLOCK ARGUMENT PUSHA /SAVE IT PUSHJ /FIND OUT IF WE WRITE LARG1, ARG /**** RELOCATE **** NL4000 /MAKE IT A READ TAD (N^100+BUFFLD+UNIT+4000)/GET OTHER FUNCTION BITS DCA FUN /PUT IN-LINE EITHER WAY POPA /RESTORE BLOCK ARGUMENT DCA TBLK /PUT IN-LINE ALSO JMS I PSYSIO/(SYSIO) /CALL FOR READ OR WRITE 0 /CORE FUN, .-. /FILLED IN TBLK, .-. /FILLED IN ION /MAKE SURE INTERRUPTS ARE STILL ON RETURN /BACK TO FOCAL / LOGICAL AND FUNCTION: FAND(FIRST-ARGUMENT,SECOND-ARGUMENT) XAND, JMS I INTEGER /GET FIRST ARGUMENT PUSHA /SAVE IT TAD FLAC+1 /GET HIGH-ORDER PUSHA /SAVE IT ALSO PUSHJ /FIND OUT VALUE OF SECOND ARGUMENT LARG2, ARG /**** RELOCATE **** JMP NOSEC /WASN'T ANY JMS I INTEGER /EVALUATE SECOND ARGUMENT CLA /THROW IT AWAY FOR NOW ZEROIN, POPA /GET FIRST HIGH-ORDER AND FLAC+1 /AND WITH SECOND HIGH-ORDER DCA FLAC+1 /SAVE RESULT POPA /GET FIRST LOW-ORDER AND FLAC+2 /AND WITH SECOND LOW-ORDER FBLKIN, DCA FLAC+2 /SAVE RESULT TAD (27) /SETUP THE DCA FLAC /NEW EXPONENT RETURN /RETURN TO FOCAL NOSEC, DCA FLAC+1 /CLEAR DCA FLAC+2 /FLAC JMP ZEROIN /CONTINUE THERE / MEMORY REFERENCE FUNCTION: FWRD(ADDRESS[,NEWVALUE]). XWRD, JMS I INTEGER /GET ADDRESS ARGUMENT IFNZRO ADR < CLL RAL /ADJUST TO DOUBLE-WORD ADDRESS > PUSHA /SAVE IT PUSHJ /EVALUATE SECOND IF ANY LARG3, ARG /**** RELOCATE **** JMP GET /NONE, JUST GET VALUE POPA /RESTORE ADDRESS DCA TBLK /SAVE AS POINTER JMS I INTEGER /GET REPLACEMENT VALUE IFNZRO ADR < CLA /THROW AWAY LOW-ORDER TAD FLAC+1 /GET HIGH-ORDER > CDF BUFFLD /GOTO BUFFER FIELD DCA I TBLK /STORE IT IFNZRO ADR < TAD TBLK /GET THE POINTER IAC /BUMP TO NEXT DCA FUN /STASH IT TAD FLAC+2 /GET LOW-ORDER DCA I FUN /STORE IT ALSO > JMP GET2 /FINISH UP GET, POPA /GET BACK ADDRESS DCA TBLK /SAVE IT GET2, CDF BUFFLD /GOTO BUFFER FIELD IFNZRO ADR < TAD I TBLK /GET HIGH-ORDER > DCA FLAC+1 /STORE IT IFNZRO ADR < ISZ TBLK /BUMP TO NEXT > TAD I TBLK /GET VALUE CDF 00 /BACK TO US JMP FBLKIN /CONTINUE THERE ARG, TAD CHAR /ARGUMENT EVALUATOR TAD (-",) /GOOD TERMINATOR? PSYSIO, SZA CLA /SKIP IF SO POPJ /RETURN IF NOT PUSHJ; EVAL-1 /EVALUATE SECOND ARGUMENT IAC /INDICATE SKIP RETURN POPJ /RETURN PAGE NEND= . /END OF RELOCATABLE PATCH CODE / ONCE-ONLY CODE STARTS HERE. *BONCE /OVER DEFAULT ONCE-ONLY AREA PBASE, TAD BOTTOM /\ TAD (-200+1) / \ESTABLISH AND P7600/[7600] / /BASE ADDRESS DCA PBASE // TAD PBASE /\ TAD (NSTART&177-1) / >ESTABLISH NEW LIMIT DCA BOTTOM // TAD PBASE /\ TAD (XBLK&177) / >INSERT FBLK DCA I (FNTABF+14) // TAD PBASE /\ TAD (XWRD&177) / >INSERT FWRD DCA I (FNTABF+15) // TAD PBASE /\ TAD (XAND&177) / >INSERT FAND DCA I (FNTABF+16) // TAD PBASE /\ TAD (ARG&177) / \ DCA I (LARG1) / \ TAD I (LARG1) / >FIXUP ADDRESS CONSTANTS DCA I (LARG2) / / TAD I (LARG2) / / DCA I (LARG3) // TAD BOTTOM /\ IAC / >SETUP MOVE BASE DCA PBASE // TAD I LNSTART /\ DCA I PBASE / \ ISZ LNSTART / \MOVE DOWN PATCH TO ISZ PBASE / /WHERE IT BELONGS ISZ MOVCNT / / JMP .-5 // DCA I (BEOFZAP) /REPAIR LOADER JMP I (BEOFZAP) /RESUME LOADING LNSTART,NSTART /POINTER TO NSTART MOVCNT, NSTART-NEND /CODE MOVE COUNTER PAGE *BEOFZAP /OVER LOADER SKP /MAKE IT COME TO US $ /THAT'S ALL FOLK!