|
DataMuseum.dkPresents historical artifacts from the history of: Philips Data Systems |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Philips Data Systems Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 24100 (0x5e24)
Notes: pts_type(SC)
Names: »VALPRC.SC«
└─⟦f45ea3bc3⟧ Bits:30009713 Philips computer tape "WSM"
└─⟦this⟧ »WSM:CREA/VALPRC.SC«
IDENT VALPRC REL=2.3,850531,870155940230 ****************************************************** * * LATEST UPDATE 850531 MADE BY JE * * HISTORY= * 850531/JE DIRECT MOVE VAL.OBJ. NOT OK WHEN DELETE FULL LINE * 850403/JE ERROR STOBUF LBIN3 NOT OK TROUBLE WHEN VALPAGE FULL * 850313/JE PERFORMANCE. DIRECT MOVE VAL.OBJ. WHEN UNCHANGED * 850220/JE SIMULATE INPUT OF LINE NUMBER WHEN DISASTER ERROR * FROM OBJVAL * 841120/CJ MUL&DIV NOW FROM ASS.ROUTINE * 841017/CJ ERROR AFTER INS LINE IN BASIC + TFD LOC=402 * 830524/CJ ROW NO LOST WHEN VALBUF EXEEDED LOC=VAL800 * 830520/CJ TAB FWD (BLAEDDRING) ERROR * WHEN VALBUF EXACT FULL LOC:=81 - NOW SOLVED * 830520/CJ ERROR IN BUFSEA WHEN VALBUF OVERFLOW - SOLVED * 830519/CJ ERROR WHEN VALBUF-MAX REACHED LOC:=03B9 * ****************************************************** DDUM WSMDDV PDIV ENTRY VALPRC ENTRY VLPAGE ***VALIDATION PAGE EXPROC ZERFLL,PSTRG,PBIN,PBIN ***ZERO REFILL /00:S EXPROC READIN,PKTAB,PKTAB,PKTAB,PLIT ***READ IN ONE FIELD EXPROC WSMERR,PKTAB,PLIT ***ERR-MESSAGE ROUTINE EXT ICLEAR ---CLEAR ITEM EXT EMPTYT ---CHECK IF EMPTY EXT GETIND ---GET ITEM LENGTH EXT WXMUL ---MULTIPLICATION EXT WXDIV ---DIVISION EJECT INCLUDE WSMKEY,LIST INCLUDE KEYT21,LIST INCLUDE KEYT22,LIST INCLUDE KEYT23,LIST EJECT INCLUDE KEYT5,LIST EJECT * * VALIDATION PROCEDURE * THIS ROUTINE HANDLES I/O OF BASIC VALIDATION LINES * BETWEEN KEYBOARD/DISPLAY AND VALIDATION BUFFER * * USED ITEMS: VBIN1 = INDEX TO NUMB-OF-CHARS-TABLE * VBIN2 = INDEX TO VALIDATION LINE OF PAGE * VBIN3 = BUFFERPOINTER OF VALIDATION SOURCE BUFFER * VBIN4 = END BPOINTER OF VALBUF * VBIN5 = FIRST FREE LINE NUMBER * VBIN6 = TEMPORARY STORAGE OF LAST LINES NUMBER OF R * VBIN7 = LENGTH OF KEYED IN LINE NUMBER * * OUTPUT CR = 0 OK * = 1 GREATER OVERFLOW * ************************************************************************ VALPRC PROC MOVE VBIN5,W0 1ST FREE LINENUMBER:=0 MOVE VBIN8,W0 VALIDATIONBUFFERPOINTER:=0 VAL020 MOVE LBIN1,W0 BASIC LINE LENGTH:=0 XCOPY LBIN1,W1,W1,VALBUF,VBIN8 GET LINE LENGTH CBE LBIN1,W0,VAL050 JMP IF END OF BUFFER REACHED ADD VBIN8,W1 ADJUST BUFFERPOINTER XCOPY VBIN5,W0,W2,VALBUF,VBIN8 GET LINE-NUMBER SUB LBIN1,W1 ADJUST LENGTH ADD VBIN8,LBIN1 ADJUST POINTER CMP VBIN8,VBBIN CHECK BUFFER LENGTH BL VAL020 GO ON IF LESS EJECT VAL050 CALL WXDIV,VBIN5,W10,VBIN5 CALC 1ST FREE LINENO CALL WXMUL,VBIN5,W10,VBIN5 ...BY GETTING EVEV 10-MULTIPEL ADD VBIN5,W10 ...AND ADD 10 CBNG VBIN5,=X'07FF',VAL060 LINE NUMBER < = 2047 B VAL600 VAL060 MOVE LINNO(VBIN2),VBIN5 STORE 1ST FREE LINENUMBER VAL065 MOVE LBIN4,VBIN2 LOAD CURR LINENO-INDEX ADD LBIN4,W10 CALC PROPER FIELD NO GETFLD 1,LBIN4,LBIN3 FINP FIELD DISPLAY 2,LBIN4,LBIN4 DISPLAY ROW NUMBER ADD LBIN4,W8 CALC PROPER FKI-SEQ,NO GETFLD 0,LBIN4,LBIN3 FKI-FIELD SETCUR CLEAR OBBOOL CLEAR DISASTER ERROR IF ANY BT VAL101 JMP IF DISASTER ERROR VAL090 CLEAR VBOOL3 FALSE= NOT E-O-P PERF READIN,KEYT1,KEYT22,KEYT3,=W'0' ***READIN ONE FIELD IB LBIN2,VAL100,VAL200, C VAL300,VAL400 EJECT VAL100 BNL VAL102 JMP IF NOT E-O-P VAL101 SET VBOOL3 TRUE=E-O-P VAL102 TBT LBOOL1,VAL110 JMP IF BACKTAB CALL EMPTYT,BASLIN(VBIN2) ---CHECK IF EMPTY BOK VAL130 JMP IF NOT EMPTY CBNE LBIN2,W1,VAL105 JMP IF NOT ENT + EMPTY TBT VBOOL3,VAL105 JMP IF E-O-P B VAL500 JMP IF ENT + EMPTY * * TAB FORWARD * VAL105 MOVE LBIN1,LINNO(VBIN2) LOAD CURRENT LINE NUMBER CBNE LBIN1,VBIN5,VAL120 JMP IF NOT 1ST FREE LINE MOVE LBIN1,W0 WORKITEM:=0 CBNL VBIN4,VBBIN,VAL107 JMP WHEN VALBUF-MAX REACHED XCOPY LBIN1,W1,W1,VALBUF,VBIN4 GET NEXT-PAGE 1ST LENGTH VAL107 CBE LBIN1,W0,VAL065 JMP IF NO PAGING NEEDED MOVE VBIN3,VBIN4 LOAD CURRENT E-O-P POINTER B VAL116 EJECT VAL110 MOVE LBIN1,LINNO(VBIN2) LOAD CURRENT LINE NUMBER CBNE LBIN1,VBIN5,VAL065 JMP IF NOT 1ST FREE LINE * * TAB BACKWARD ====> SEARCH 7 PREVIOUS LINES * CBNE VBIN3,W0,VAL111 JMP IF NOT 1ST PAGE ON SCREEN B VAL700 JMP IF 1ST PAGE AND BACKTAB VAL111 MOVE LBIN1,W0 BUFFER POINTER:=0 MOVE VBIN8,W0 BASIC LINE LENGTH:=0 CALL ICLEAR,LSTR16 ---CLEAR ITEM VAL112 XCOPY VSTR2,W0,W2,LBIN1,W0 LOAD LINE POINTER INSRT LSTR16,W0,W2,VSTR2,W0 INSRT LINE POINTER XCOPY VBIN8,W1,W1,VALBUF,LBIN1 GET BASIC LINE LENGTH CBE VBIN8,W0,VAL114 JMP IF E-O-B FOUND ADD LBIN1,VBIN8 ADJUST POINTER CBE LBIN1,VBBIN,VAL114 JMP IF END LIMIT REACHED CBNE LBIN1,VBIN3,VAL112 JMP IF B-O-P NOT FOUND VAL114 XCOPY VBIN3,W0,W2,LSTR16,W8 LOAD STARTPOINT OF PREV PAGE VAL116 MOVE LBIN1,=W'29' FIELD SEQ NO ERASE 2,LBIN1,W0 ERASE REST OF PAGE MOVE VBIN1,W9 NUMB-OF-CHARS-TABLE-INDEX:=9 MOVE VBIN2,W1 LINE INDEX:=1 MOVE VBIN8,VBIN3 LOAD B-O-P POINTER MOVE LBIN4,=W'29' FIELD SEQ NO B VAL125 EJECT * * DELETION EMPTY BASIC LINE + NOT 1ST FREE LINE * VAL120 MOVE LINNO(W9),LBIN1 LOAD WANTED LINE NUMBER MOVE VBIN8,VBIN3 LOAD B-O-P- POINTER PERF BUFSEA,VBOOL2,LBIN1,LBIN3,VBIN8,LBIN4 ***BUFFER SEARCH TBF VBOOL2,VAL122 JMP IF NOT FOUND NO DELETE DLETE VALBUF,VBIN8,LBIN4 DELET EMPTIED LINE SET CHABOL T=VALIDATION ROUTINE CHANGED MOVE LBIN1,VBBIN STORE LENGTH OF VALBUF PERF ZERFLL,VALBUF,LBIN1,LBIN4 ***ZERO REFILL /00:S VAL122 MOVE LBIN4,VBIN2 LOAD CURRENT LINE NUMBER INDEX ADD LBIN4,LBIN4 CALC PROPER FKI FINP ADD LBIN4,=W'27' ...SEQ.NO ERASE 2,LBIN4,W0 ERASE REST OF PAGE VAL125 CBNE LBIN2,W1,VAL128 JMP IF NOT ENTER TBT VBOOL3,VAL128 JMP IF E-O-P B VAL500 JMP IF ENTER VAL128 PERF VLPAGE,VBIN8 ***VALIDATION PAGE LOAD MOVE LINNO(VBIN2),VBIN5 LOAD 1ST FREE LINE NUMBER DISPLAY 3,LBIN4,W0 DISPLAY REST OF PAGE B VAL065 EJECT VAL130 * * TYPE OF INPUT : 1.ONLY LINE NUMBER * 2.LINE NUMBER + BASIC STATMENT * 3.ONLY BASIC STATMENT * CALL ICLEAR,LSTR4A ---CLEAR ITEM MOVE VBIN7,W0 ACTUAL LINE NUMBER LENGTH:=0 MOVE LBIN1,W4 LOAD MAXLENGTH OF LINE NUMBER CBG GBINIA(VBIN1),W4,VAL134 JMP IF GREATER MAXLENGTH MOVE LBIN1,GBINIA(VBIN1) LOAD ACTUAL LENGTH < 4 VAL134 XCOPY LSTR1,W0,W1,BASLIN(VBIN2),VBIN7 GET ONE CHARACTER CBL LSTR1,=X'30',VAL136 JMP IF NOT A DIGIT CBG LSTR1,=X'39',VAL136 JMP IF NOT A DIGIT XCOPY LSTR4A,VBIN7,W1,LSTR1,W0 STORE DIGIT ADD VBIN7,W1 ADJUST LINE NUMBER LENGTH CBNE VBIN7,LBIN1,VAL134 JMP IF NOT MAXLENGTH VAL136 MOVE LINNO(W9),LSTR4A CONVERT TO BCD CBNE LINNO(W9),=D'00',VAL141 JMP IF NOT ONLY BASIC STATM B VAL190 JMP WHEN ONLY BASIC STATEMENT VAL141 CLEAR VBOOL4 FALSE = NO DELETE MOVE LBIN1,LINNO(VBIN2) LOAD LINE NUMBER BINARY CBE LBIN1,VBIN5,VAL142 JMP IF 1ST FREE LINE PERF LINSEA,VBOOL1,VBIN8 ***LINE NUMBER WHITIN SCREEN TBF VBOOL1,VAL142 JMP IFLINE NUMBER NOT ON SCREEN EJECT * * BASIC LINE OVERWRITTEN WITH AT LEAST LINE NUMBER * DELETE THE OVERWRITTEN LINE * MOVE LINNO(W9),LINNO(VBIN2) LOAD CURRENT LINE NUMBER MOVE VBIN8,W0 STARTPOINT AT SEARCH PERF BUFSEA,VBOOL2,LBIN1,LBIN3,VBIN8,LBIN4 ***BUFFER SEARCH TBF VBOOL2,VAL142 JMP IF NOT FOUND IN BUFFER DLETE VALBUF,VBIN8,LBIN4 DELET FOUND LINE SET CHABOL T=VALIDATION ROUTINE CHANGED MOVE LBIN1,VBBIN STORE LENGTH OF VALBUF PERF ZERFLL,VALBUF,LBIN1,LBIN4 ***ZERO REFILL /00:S MOVE LINNO(W9),LSTR4A CONVERT TO BCD SET VBOOL4 TRUE = DELETION MADE EJECT * * LINE NUMBER FOUND * VAL142 CBNG GBINIA(VBIN1),VBIN7,VAL143 JMP IF JUST LINE NUMBER ADD VBIN7,W1 ADJUST FOR SPACE BETWEEN VAL143 DLETE BASLIN(VBIN2),W0,VBIN7 DLETE LINENUMBER SUB GBINIA(VBIN1),VBIN7 ADJUST LENGTH PERF LINSEA,VBOOL1,VBIN8 ***LINE NUMBER WHITIN SCREEN TBT VBOOL4,VAL144 JMP IF DELETION WAS MADE TBT VBOOL1,VAL180 JMP IF LINE FOUND IN SCREEN VAL144 MOVE VBIN6,GBINIA(VBIN1) SAVE NUMB OF CHARS CALL ICLEAR,LSTR81 ---CLEAR ITEM XCOPY LSTR81,W0,VBIN6,BASLIN(VBIN2),W0 MOVE VBIN2,W1 LINE-NUMBERINDEX:=1 MOVE VBIN1,W9 NUMB-OF-CHARS-TABL-INDEX:=9 MOVE LBIN1,=W'29' FIELD SEQ NO ERASE 2,LBIN1,W0 TBT VBOOL1,VAL148 JMP IF LINE FOUND IN SCREEN MOVE VBIN8,W0 STARTPOINT AT SEARCH PERF BUFSEA,VBOOL2,LBIN1,LBIN3,VBIN8,LBIN4 ***BUFFER SEARCH MOVE VBIN3,VBIN8 UPDATE BUFFER POINTER TBT VBOOL2,VAL170 JMP IF LINE FOUND MOVE LINNO(VBIN2),LINNO(W9) ADD VBIN2,W1 LINENUMBERINDEX:=2 ADD VBIN1,W1 NUMB-OF-CHARS-TABLE-INDEX:=10 CBG LBIN4,W0,VAL170 JMP IF INSERTION EJECT * * LINE NUMBER OUT OF BUFFER NEW LINE * MOVE VBIN5,LINNO(W9) NEW 1ST FREE LINE NUMBER MOVE VBIN2,W1 LINE-INDEX:=1 MOVE VBIN1,W9 NUMB-OF-CHARS-TABLE-INDEX:=9 MOVE GBINIA(VBIN1),VBIN6 RESTORE NUMB OF CHARS CBNE GBINIA(VBIN1),W0,VAL145 JMP IF MORE THAN LINE NUMBER CBE LBIN2,W1,VAL500 JMP IF ENTER B VAL060 JMP IF ONLY LINE NUMBER * * LINE NUMBER OUT OF BUFFER NEW LINE + BASIC STATMENT * VAL145 XCOPY BASLIN(VBIN2),W0,VBIN6,LSTR81,W0 RESTORE BASIC STATMENT MOVE LBIN1,=W'29' FIELD SEQ NO DISPLAY 3,LBIN1,W0 DISPLAY B VAL190 STORE BASIC STATEMNET * * REORGANIZE & DISPLAY VALIDATION PAGE IF BASIC LINE WAS OVERWRITTEN * VAL148 MOVE VBIN8,VBIN3 LOAD B-O-P POINTER EJECT * * LINE NUMBER FOUND /NOT FOUND WITHIN BUFFER * VAL170 PERF VLPAGE,VBIN8 ***VALIDATION PAGE LOAD MOVE LINNO(VBIN2),VBIN5 STORE 1ST FREE LINENUMBER MOVE LBIN1,=W'29' FIELD SEQ NO DISPLAY 3,LBIN1,W0 DISPLAY NEW PAGE XCOPY BASLIN(VBIN2),W0,VBIN6,LSTR81,W0 RESTORE BASIC STATEMNET MOVE GBINIA(VBIN1),VBIN6 RESTORE NUMB OF CHARS PERF LINSEA,VBOOL1,VBIN8 ***LINE NUMBER WHITHIN SCREEN EJECT * * LINE NUMBER FOUND WITHIN SCREEN * VAL180 CBE GBINIA(VBIN1),W0,VAL185 JMP IF NO BASIC STATMENT * * ...... AND FOLLOWED BY A BASIC STATEMENT * MOVE LBIN3,VBIN8 LOAD LINE INDEX ADD LBIN3,W18 CALC PROPER FIELD NO ERASE 10,LBIN3,LBIN3 ERASE OLD VALUE XCOPY BASLIN(VBIN8),W0,GBINIA(VBIN1),BASLIN(VBIN2),W0 DISPLAY 1,LBIN3,LBIN3 DISPLAY NEW VALUE * * .......BUT NOT FOLLOWED BY A BASIC STATEMENT * VAL185 MOVE LBIN3,VBIN2 LOAD CURR LINE INDEX ADD LBIN3,W18 CALC PROPER FIELD SEQ NO ERASE 10,LBIN3,LBIN3 ERASE ROW NUMBER ENTERED MOVE VBIN2,VBIN8 MAKE NEW LINE CURRENT ADD VBIN8,W8 CALC NUMB-OF-CHARS-TABLE-INDEX CBE GBINIA(VBIN1),W0,VAL192 JMP IF JUST LINE NUMBER MOVE GBINIA(VBIN8),GBINIA(VBIN1) RESTORE NUMB OF CHARS MOVE GBINIA(VBIN1),W0 CLEAR NUMB OF CHARS MOVE VBIN1,VBIN8 MAKE NEW INDEX CURRENT EJECT * * BASIC LINE IN VALIDATION BUFFER * VAL190 PERF STOBUF ***STORE BASIC LINE IN BUFFER BG VAL800 JMP IF MEMORY OVERFLOW SET CHABOL T=VALIDATION ROUTINE CHANGED MOVE VBIN8,LINNO(VBIN2) CONVERT TO BIN CBE VBIN8,VBIN5,VAL195 JUMP IF 1ST FREE LINE MOVE LINNO(W9),VBIN5 LOAD 1ST FREE LINE NUMBER PERF LINSEA,VBOOL1,VBIN8 ***LINE NUMBER WITHIN SCREEN MOVE VBIN2,VBIN8 LOAD FOUND INDEX ADD VBIN8,W8 CALC NUMB-OF-CHARS-TABLE-INDEX VAL192 MOVE VBIN1,VBIN8 LOAD NUMB-OF-CHARS-TABLE-INDEX TBT VBOOL3,VAL193 JMP IF E-O-P CBE LBIN2,W1,VAL500 JMP IF ENTER-KEY VAL193 B VAL065 GO ON VAL195 ADD VBIN1,W1 NEXT LINE INDEX ADD VBIN2,W1 NEXT LINE INDEX CBL VBIN2,W9,VAL199 E-O-P MOVE VBIN3,LBIN3 LOAD NEW B-O-P POINTER MOVE VBIN1,W9 NUMB-OF-CHARS-TABLE-INDEX:=9 MOVE VBIN2,W1 LINE INDEX:=1 MOVE LBIN1,=W'29' FIELD SEQ NO ERASE 2,LBIN1,W0 ERASE VAL PAGE EJECT VAL199 TBT VBOOL3,VAL19A JMP IF E-O-P CBE LBIN2,W1,VAL500 JMP IF ENTER-KEY VAL19A B VAL050 GO ON * * CANCEL KEY * VAL200 CMP W1,W1 CR:=0 MOVE LBIN2,W2 B VAL999 * * RETUR-KEY * VAL300 CMP W1,W1 CR:=0 MOVE LBIN2,W3 B VAL999 * * POWER OFF * VAL400 DISPLAY 0,W1,W0 B VAL065 EJECT * * ENTER-KEY * VAL500 MOVE LBIN2,W1 OK B VAL999 * * LINE NUMBER OUT OF RANGE * VAL600 MOVE LBIN2,W4 B VAL999 * * BACKTAB FROM 1ST PAGE OF VALIDATION * VAL700 MOVE LBIN2,W5 MOVE LBIN4,W18 FKI-FIELD NUMBER TO BE CURRENT B VAL999 * * WORKING AREA VALBUF EXEEDED * VAL800 MOVE VBIN8,LBIN5 SAVE CURRENT ROW NO. MOVE LBIN5,W5 VALBUF-OVERFLOW MOVE LBIN1,W0 NO CLEAR MOVE LBIN4,W2 ERR-MESSAGE NO:2 PERF WSMERR,KEYT5,=W'0' ***ERR-MESSAGE ROUTINE MOVE LBIN5,VBIN8 RESTORE ROWNO IB LBIN2,VAL065,VAL200, CLR,CAN C VAL300,VAL500 RET,ENT EJECT * * EXIT * VAL999 RET PEND EJECT * * LINE NUMBER WITHIN BUFFER * THIS ROUTINE SEARCH'S AND COMPARE * WHEATHER KEYED IN LINE NUMBER * EXISTS IN VALIDATION OR NOT * * INPUT: LINNO(W9) = KEYED IN LINENUMBER * BPOINT = BUFFER POINTER * * * OUTPUT: WITHIN = FALSE = NOT FOUND * TRUE = FOUND * BPOINT =FOUND ENTRY POINT OF VALBUF * LENGTH = 0 = E-O-B FOUND * > 0 = INSERTTION OF LINE * ************************************************************************ BUFSEA PROC WITHIN,INLIN,BULIN,BPOINT,LENGTH PBOOL WITHIN PBIN INLIN INPUT LINE NUMBER PBIN BULIN FOUND LINE NUMBER IN BUFFER PBIN BPOINT BUFFERPOINTER PBIN LENGTH BASIC LINE LENGTH MOVE INLIN,LINNO(W9) CONVERT TO BINARY CLEAR WITHIN FALSE = NOT FOND EJECT BUF010 MOVE LENGTH,W0 MOVE BULIN,W0 BUFFER LINE NUMBER:=0 CBNL BPOINT,VBBIN,BUF020 JMP IF VALBUF MAX REACHED XCOPY LENGTH,W1,W1,VALBUF,BPOINT GET LENGTH BUF020 CBE LENGTH,W0,BUF980 JMP IF E-O-B FOUND ADD BPOINT,W1 ADJUST BUFFER POINTER XCOPY BULIN,W0,W2,VALBUF,BPOINT GET LINE NUMBER CMP INLIN,BULIN COMPARE INLINE<=>BUFLINE BE BUF100 JMP IF EXISTING LINE BL BUF200 JMP IF INSERT LINE SUB LENGTH,W1 ADD BPOINT,LENGTH ADJUST BUFFER POINTER B BUF010 GO ON * * LINE NUMBER FOUND * BUF100 SET WITHIN TRUE = FOUND * * LINE NUMBER NOT FOUND * BUF200 SUB BPOINT,W1 ADJUST POINTER WHEN FOUND BUF980 RET PEND EJECT * * VALIDATION PAGE LOAD * * THIS ROUTINE UNPACK AND LOAD A VALIDATION PAGE * CONSISITING OF 7 LINES * * INPUT: VALBUF = VALIDATION BUFFER * VBIN1 = INDEX TO NUMB-OF-CHARS-TABLE * VBIN2 = LINE NUMBER INDEX * STPNT = START POINTER IN VALBUF * * OUTPUT: VBIN4 = END-OF-PAGE BUFFER POINTER (BACK-PAGING) * VBIN2 = UPDATED * VBIN1 = UPDATED * BASLIN = BASIC LINE SOURCE * GBINIA = NUMBER CHARS OF BASIC LINE * ************************************************************************ VLPAGE PROC STPNT PBIN STPNT START POINTER EJECT VLP020 MOVE LBIN1,W0 WORKITEM:=0 XCOPY LBIN1,W1,W1,VALBUF,STPNT GET BASIC LINE LENGTH CBE LBIN1,W0,VLP900 JMP IF END-OF-BUFFER ADD STPNT,W1 ADJUST BUFFERPOINTER XCOPY LBIN3,W0,W2,VALBUF,STPNT LOAD LINE NUMBER ADD STPNT,W2 ADJUST BUFFERPOINTER MOVE LINNO(VBIN2),LBIN3 LOAD LINE NUMBER SUB LBIN1,W3 ADJUST LEN FOR LEN+LINENO MOVE GBINIA(VBIN1),LBIN1 STORE NUMB OF CHARS XCOPY BASLIN(VBIN2),W0,LBIN1,VALBUF,STPNT STORE BASIC LINE ADD STPNT,LBIN1 ADJUST BUFFERPOINTER ADD VBIN2,W1 INCREMENT LINENUMBER-INDEX ADD VBIN1,W1 INCREMENT TABLE-INDEX CBE STPNT,VBBIN,VLP900 JMP IF END LIMIT REACHED CBNE VBIN2,W8,VLP020 JMP IF PAGE FULL VLP900 MOVE VBIN4,STPNT STORE END-OF-PAGE BUF POINTER MOVE STPNT,VBIN1 SAVE INDEX VLP910 MOVE GBINIA(STPNT),W0 ZEROISE ADD STPNT,W1 NEXT INDEX CBL STPNT,W17,VLP910 JMP IF NOT ALL ZEROISED RET PEND EJECT * * LINE NUMBER WITHIN SCREEN * * THIS ROUTINE SEARCH7S AND COMPARE IF KEYED IN * LINE NUMBER EXISTS ON SCREEN * * INPUT: LINNO(W9) = KEYED IN LINE NUMBER * * OUTPUT:FOUND = FALSE = NOT FOUND * = TRUE = FOUND * LININX = LINE INDEX * ************************************************************************ LINSEA PROC FOUND,LININX PBOOL FOUND PBIN LININX MOVE LININX,W1 CLEAR FOUND FALSE = NOT FOUND LIN010 CBE LINNO(W9),LINNO(LININX),LIN050 JMP IF EQUAL CBE LININX,W8,LIN999 NOT FOUND ADD LININX,W1 INCREMENT LINE NUMBER INDEX B LIN010 GO ON LIN050 SET FOUND TRUE = FOUND LIN999 RET PEND EJECT * * STORE VALIDATION BASIC LINE IN VALIDATION BUFFER * * INPUT: BASLIN = BASIC STATEMENT LINE * VBIN2 = INDEX TO BASLIN * GBINIA = NUMB-OF-CHARS-TABLE * VBIN1 = INDEX TO GBINIA * LINNO = LINE NUMBER * VBIN3 = STARTPOINT OF VALIDATION PAGE * VALBUF = VALIDATION BUFFER * * USED: LBIN1 = WORK/OLD BASIC LINE LENGTH * VBIN8 = NEW BASIC LINE LENGTH * LBIN3 = POINTER VALBUF * LSTR4A = INTERMEDIATE BUFFER LENGTH+LINENUMBER * * OUTPUT: VALBUF = VALIDATION BUFFER UPDATED * CR = 0 OK * = 1 MEMORY OVERFLOW * ************************************************************************ STOBUF PROC MOVE LINNO(W9),LINNO(VBIN2) LOAD CURRENT LINE NUMBER MOVE LBIN3,VBIN3 LOAD STARTPOINT IN BUFFER PERF BUFSEA,VBOOL2,LBIN1,VBIN8,LBIN3,LBIN4 ***BUFFER SEARCH MOVE VBIN8,GBINIA(VBIN1) STORE LENGTH MOVE LBIN4,VBIN8 LOAD LENGTH ADD LBIN4,LBIN3 CALC END POS FOR THIS LINE *TBT VBOOL2,STB050 JMP IF LINE ALREADY EXIST ADD LBIN4,W3 ADJUST FOR LEN + LINENR *STB050 CMP LBIN4,VBBIN CHECK SIZE OF BUFFER BG STB999 JMP IF OVERFLOW EJECT ADD VBIN8,W3 ADJUST LEN FOR LEN+LINENO MOVE LBIN1,LINNO(VBIN2) CONVERT LINENUMBER TO BIN XCOPY LSTR4A,W0,W1,VBIN8,W1 STORE INTERMEDIATE LEN XCOPY LSTR4A,W1,W2,LBIN1,W0 STORE INTERMEDIATE LINENO SUB VBIN8,W3 ADJUST NEW LENGTH TBT VBOOL2,STB100 JMP IF LINE EXIST * * INSERTION OF NEW LINE * INSRT VALBUF,LBIN3,W3,LSTR4A,W0 INSERT LEN+LINE NO BOFL STB980 JMP IF OVERFLOW ADD LBIN3,W3 ADJUST BUFFER-POINTER INSRT VALBUF,LBIN3,VBIN8,BASLIN(VBIN2),W0 INSERT BASIC LINE BOFL STB980 JMP IF OVERFLOW ADD LBIN3,VBIN8 ADJUST TO GET B-O-P POINTER ADD VBIN8,W3 ADJUST LEN FOR LEN+LINENO ADD VBIN4,VBIN8 ADJUST E-O-P BUFFER POINTER B STB350 EXIT * * LINE EXIST'S IN VALIDATION BUFFER * STB100 MOVE LBIN1,W0 OLD BASIC LINE LENGTH:=0 XCOPY LBIN1,W1,W1,VALBUF,LBIN3 GET OLD BASICLINE LENGTH SUB LBIN1,W3 ADJUST OLD LENGTH CMP LBIN1,VBIN8 COMPARE OLD<=>NEW LENGTHS BE STB300 JMP IF EQUAL LENGTH BL STB200 JMP IF OLD < NEW LENGTH EJECT * * OLD LENGTH > NEW LENGTH * XCOPY VALBUF,LBIN3,W3,LSTR4A,W0 STORE NEW LENGTH ADD LBIN3,W3 ADJUST BUFFERPOINTER XCOPY VALBUF,LBIN3,VBIN8,BASLIN(VBIN2),W0 LOAD UPD BASIC LINE ADD LBIN3,VBIN8 ADJUST BUFFER POINTER SUB LBIN1,VBIN8 CALC NUMB OF OVERFLOW CHARS CBE VBIN4,W0,STB150 JMP IF STILL 1ST PAGE SUB VBIN4,LBIN1 ADJUST E-O-P POINTER STB150 DLETE VALBUF,LBIN3,LBIN1 DELETE OVERFLOW CHARACTERS MOVE LBIN3,VBBIN LOAD LENGTH OF VALBUF PERF ZERFLL,VALBUF,LBIN3,LBIN1 ***ZERO REFILL X /00:S B STB350 EJECT * * OLD LENGTH < NEW LENGTH * STB200 XCOPY VALBUF,LBIN3,W3,LSTR4A,W0 STORE NEW LENGTH ADD LBIN3,W3 ADJUST BUFFER POINTER XCOPY VALBUF,LBIN3,LBIN1,BASLIN(VBIN2),W0 LOAD 1ST PART ADD LBIN3,LBIN1 ADJUST BUFFERPOINTER SUB VBIN8,LBIN1 CALC REST OF CHARS CBE VBIN4,W0,STB250 JMP IF STILL 1ST PAGE ADD VBIN4,VBIN8 ADJUST E-O-P POINTER STB250 INSRT VALBUF,LBIN3,VBIN8,BASLIN(VBIN2),LBIN1 INSERT 2ND PART BOFL STB980 JMP IF MEMORY OVERFLOW B STB999 * * OLD LENGTH = NEW LENGTH * STB300 ADD LBIN3,W3 ADJUST POINTER XCOPY VALBUF,LBIN3,VBIN8,BASLIN(VBIN2),W0 UPDATE BASIC LINE STB350 CMP W1,W1 CR:=0 B STB999 EXIT * * MEMORY OVERFLOW * STB980 CMP W1,W0 CR:=1 STB999 RET PEND END