MOVE.L NATWID(PSP),A0 ; Buffer to scan in.\r
CLR.L D1 ; Initialize offset. (No particular limit on Buffer width.)\r
* Scan to a non-delimiter or a NUL\r
-ENCDEL TST.B (A0,D1) ; NUL ?\r
+ENCDEL TST.B (A0,D1.W) ; NUL ?\r
BEQ.S ENCNUL\r
- CMP.B (A0,D1),D0 ; Delimiter?\r
+ CMP.B (A0,D1.W),D0 ; Delimiter?\r
BNE.S ENC1ST\r
ADDQ.L #1,D1 ; count character\r
BRA.S ENCDEL\r
* Found first character. Save the offset.\r
ENC1ST MOVE.L D1,(PSP) ; Found first non-delimiter character -- store the count.\r
* Scan to a delimiter or a NUL\r
-ENCSYM TST.B (A0,D1) ; NUL ?\r
+ENCSYM TST.B (A0,D1.W) ; NUL ?\r
BEQ.S ENC0TR\r
- CMP.B (A0,D1),D0 ; delimiter?\r
+ CMP.B (A0,D1.W),D0 ; delimiter?\r
BEQ.S ENCEND\r
ADDQ.L #1,D1\r
BRA.S ENCSYM\r
* USER variables are similiar to VARIABLEs,\r
* but are allocated (by hand!) in the per-user table. \r
* A USER variable's parameter field contains its offset in the per-user table.\r
-DOUSER MOVE.L UP,A0 ; Copy base of per-user/task space.\r
- ADD.L NATWID(W),A0 ; Offset into the table.\r
+* DOUSER MOVE.L UP,A0 ; Copy base of per-user/task space.\r
+* ADD.L NATWID(W),A0 ; Offset into the table.\r
+* MOVE.L A0,-(PSP)\r
+* BRA.W NEXT\r
+DOUSER MOVE.L NATWID(W),D0 ; Offset into the table.\r
+ LEA (UP,D0.L),A0\r
MOVE.L A0,-(PSP)\r
BRA.W NEXT\r
+\r
* Hey, the per-user table can actually be larger than 256 bytes!\r
*\r
PAGE\r
MAX DC.L *+NATWID\r
MOVE.L (PSP)+,D0\r
CMP.L (PSP),D0\r
- BLE.S MINX\r
+ BLE.S MAXX\r
MOVE.L D0,(PSP) \r
MAXX BRA.W NEXT \r
* MAX DC.L DOCOL,OVER,OVER,LESS,ZBRAN\r
*\r
* ######>> screen 39 <<\r
* ======>> 98.1 <<\r
-* Supplemental:\r
+* Supplemental, intended to be used in refactoring TRAVERSE,\r
+* But really would not work there without more code:\r
* ( n<0 --- -1 )\r
* ( n>=~ --- 1 )\r
* Change top integer to its sign.\r
DC.L DDUP-5-NATWID\r
SIGNUM DC.L *+NATWID\r
SIGNUE CLR.L D0\r
- TST (PSP)\r
+ TST.L (PSP)\r
SMI D0\r
EXT.W D0\r
EXT.L D0\r
MOVE.L D0,(PSP)\r
BRA.W NEXT\r
*\r
+* ======>> 98 <<\r
+* ( adr1 direction --- adr2 )\r
+* TRAVERSE the symbol name.\r
+* If direction is 1, find the end.\r
+* If direction is -1, find the beginning.\r
+ EVEN\r
+ DC.B 0\r
+ DC.B $88\r
+ DC.B 'TRAVERS' ; 'TRAVERSE'\r
+ DC.B $C5\r
+ DC.L SIGNUM-7-NATWID\r
+* TRAV DC.L *+NATWID\r
+* MOVEQ #1,D1 ; Convert negative to -1, zero or positive to 1.\r
+* TST.L (PSP)+\r
+* BPL.S TRAVG\r
+* NEG.L D1\r
+* TRAVG MOVE.L (PSP),A0\r
+* MOVEQ #$7F,D0\r
+* TRAVLP LEA (A0,D1.W),A0 ; Don't look at the one we start at.\r
+* CMP.B (A0),D0 ; Not sure why we aren't just doing MOVE.B (A0),D2 ; BPL TRAVLP.\r
+* BCC.S TRAVLP\r
+* TRAVDN MOVE.L A0,(PSP)\r
+* BRA.W NEXT\r
+* Doing this in 68000 or 6809 just because it can be done was getting too greedy.\r
+TRAV DC.L DOCOL,SWAP\r
+TRAV2 DC.L OVER,PLUS,LIT16\r
+ DC.W $7F\r
+ DC.L OVER,CAT,LESS,ZBRAN\r
+ DC.L TRAV2-*-NATWID\r
+ DC.L SWAP,DROP\r
+ DC.L SEMIS\r
+*\r
+* ======>> 99 <<\r
+* ( --- symptr )\r
+* Fetch CURRENT as a per-USER constant.\r
+ EVEN\r
+ DC.B 0\r
+ DC.B $86\r
+ DC.B 'LATES' ; 'LATEST'\r
+ DC.B $D4\r
+ DC.L TRAV-9-NATWID\r
+LATEST DC.L DOCOL,CURENT,AT,AT\r
+ DC.L SEMIS\r
+* LATEST DC.L *+NATWID\r
+* Getting too greedy:\r
+* MOVE.L XCURR-UORIG(UP),D0\r
+* MOVE.L (UP,D0.L),A0\r
+* MOVE.L (A0),A0\r
+* MOVE.L A0,-(PSP)\r
+* BRA.W NEXT\r
+* Too greedy, still too many smantic holes in the model to fall through.\r
+* Also, if the address at the CFA is made relative, \r
+* this is part of the code that would be affected --\r
+* especially if it is in native CPU code.\r
+*\r
+* ======>> 100 <<\r
+* Wanted to do these as INCREMENTERs,\r
+* but I need to stick with the model as much as possible,\r
+* (mostly, LOL) adding code only to make the model more clear.\r
+* ( pfa --- lfa ) \r
+* Convert PFA to LFA, unchecked. (Bump back from contents to allocation link.)\r
+ EVEN\r
+ DC.B $83\r
+ DC.B 'LF' ; 'LFA'\r
+ DC.B $C1\r
+ DC.L LATEST-7-NATWID\r
+LFA DC.L DOCOL,LIT16\r
+* DC.W 4 ; on 6800\r
+ DC.W 2*NATWID\r
+ DC.L SUB\r
+ DC.L SEMIS\r
+*\r
+* ======>> 101 <<\r
+* ( pfa --- cfa ) \r
+* Convert PFA to CFA, unchecked. (Bump back from contents to characterist code link.)\r
+ EVEN\r
+ DC.B $83\r
+ DC.B 'CF' ; 'CFA'\r
+ DC.B $C1\r
+ DC.L LFA-4-NATWID\r
+* CFA DC.L DOCOL,TWO,SUB ; on 6800\r
+CFA DC.L DOCOL,NATWC,SUB\r
+ DC.L SEMIS\r
+*\r
+* ======>> 102 <<\r
+* ( pfa --- nfa ) \r
+* Convert PFA to NFA. (Bump back from contents to beginning of symbol name.)\r
+ EVEN\r
+ DC.B $83\r
+ DC.B 'NF' ; 'NFA'\r
+ DC.B $C1\r
+ DC.L CFA-4-NATWID\r
+NFA DC.L DOCOL,LIT16\r
+* DC.W 5 ; on 6800\r
+ DC.W NATWID*2+1\r
+ DC.L SUB,ONE,MINUS,TRAV\r
+ DC.L SEMIS\r
+*\r
+* ======>> 103 <<\r
+* ( nfa --- pfa ) \r
+* Convert NFA to PFA. (Bump up from beginning of symbol name to contents.)\r
+ EVEN\r
+ DC.B $83\r
+ DC.B 'PF' ; 'PFA'\r
+ DC.B $C1\r
+ DC.L NFA-4-NATWID\r
+PFA DC.L DOCOL,ONE,TRAV,LIT16\r
+* DC.W 5 ; on 6800\r
+ DC.W NATWID*2+1\r
+ DC.L PLUS\r
+ DC.L SEMIS\r
+*\r
+* ######>> screen 40 <<\r
+* ======>> 104 <<\r
+* ( --- )\r
+* Save the parameter stack pointer in CSP for compiler checks.\r
+ EVEN\r
+ DC.B 0\r
+ DC.B $84\r
+ DC.B '!CS' ; '!CSP'\r
+ DC.B $D0\r
+ DC.L PFA-4-NATWID\r
+SCSP DC.L DOCOL,SPAT,CSP,STORE\r
+ DC.L SEMIS\r
+*\r
\r
\r
*\r
DODOES:\r
DOVOC:\r
QEXEC:\r
-SCSP:\r
QCSP:\r
CREATE:\r
RBRAK:\r
\r
******* Continue from the LOOP variables ********\r
\r
-* ======>> 98 <<\r
-* ( adr1 direction --- adr2 )\r
-* TRAVERSE the symbol name.\r
-* If direction is 1, find the end.\r
-* If direction is -1, find the beginning.\r
- FCB $88\r
- FCC 'TRAVERS' ; 'TRAVERSE'\r
- FCB $C5\r
- FDB SIGNUM-9\r
-* TRAV FDB *+NATWID\r
-* BSR SIGNUE ; Convert negative to -, zero or positive to 1.\r
-* LDD ,U++ ; Still in D, but we have to pop it anyway.\r
-* LDX ,U ; If D is 1 or -1, so is B.\r
-* LDA #$7F \r
-* TRAVLP LEAX B,X ; Don't look at the one we start at.\r
-* CMPA ,X ; Not sure why we aren't just doing LDA ,X ; BPL.\r
-* BCC TRAVLP\r
-* TRAVDN STX ,U\r
-* LBRA NEXT\r
-* Doing this in 6809 just because it can be done was getting too greedy.\r
-TRAV FDB DOCOL,SWAP\r
-TRAV2 FDB OVER,PLUS,LIT16\r
- FCB $7F\r
- FDB OVER,CAT,LESS,ZBRAN\r
- FDB TRAV2-*-NATWID\r
- FDB SWAP,DROP\r
- FDB SEMIS\r
-*\r
-* ======>> 99 <<\r
-* ( --- symptr )\r
-* Fetch CURRENT as a per-USER constant.\r
- FCB $86\r
- FCC 'LATES' ; 'LATEST'\r
- FCB $D4\r
- FDB TRAV-11\r
-LATEST FDB DOCOL,CURENT,AT,AT\r
- FDB SEMIS\r
-* LATEST FDB *+NATWID\r
-* Getting too greedy:\r
-* Version 1:\r
-* TFR DP,A\r
-* CLRB\r
-* TFR D,X\r
-* LDD CURENT+NATWID,PCR\r
-* LDX [D,X]\r
-* PSHU X ; Leave the address in X.\r
-* LBRA NEXT\r
-* Version 2:\r
-* LEAX CURENT,PCR\r
-* JSR [,X]\r
-* PULU X\r
-* LDX [,X]\r
-* PSHU X\r
-* LBRA NEXT \r
-* Too greedy, too many smantic holes to fall through.\r
-* If the address at the CFA is made relative, \r
-* this is part of the code that would be affected \r
-* if it is in native CPU code.\r
-*\r
-* ======>> 100 <<\r
-* Wanted to do these as INCREMENTERs,\r
-* but I need to stick with the model as much as possible,\r
-* (mostly, LOL) adding code only to make the model more clear.\r
-* ( pfa --- lfa ) \r
-* Convert PFA to LFA, unchecked. (Bump back from contents to allocation link.)\r
- FCB $83\r
- FCC 'LF' ; 'LFA'\r
- FCB $C1\r
- FDB LATEST-9\r
-LFA FDB DOCOL,LIT16\r
-* FCB 4\r
- FCB 2*NATWID\r
- FDB SUB\r
- FDB SEMIS\r
-*\r
-* ======>> 101 <<\r
-* ( pfa --- cfa ) \r
-* Convert PFA to CFA, unchecked. (Bump back from contents to characterist code link.)\r
- FCB $83\r
- FCC 'CF' ; 'CFA'\r
- FCB $C1\r
- FDB LFA-6\r
-* CFA FDB DOCOL,TWO,SUB\r
-CFA FDB DOCOL,NATWC,SUB\r
- FDB SEMIS\r
-*\r
-* ======>> 102 <<\r
-* ( pfa --- nfa ) \r
-* Convert PFA to NFA. (Bump back from contents to beginning of symbol name.)\r
- FCB $83\r
- FCC 'NF' ; 'NFA'\r
- FCB $C1\r
- FDB CFA-6\r
-NFA FDB DOCOL,LIT16\r
-* FCB 5\r
- FCB NATWID*2+1\r
- FDB SUB,ONE,MINUS,TRAV\r
- FDB SEMIS\r
-*\r
-* ======>> 103 <<\r
-* ( nfa --- pfa ) \r
-* Convert NFA to PFA. (Bump up from beginning of symbol name to contents.)\r
- FCB $83\r
- FCC 'PF' ; 'PFA'\r
- FCB $C1\r
- FDB NFA-6\r
-PFA FDB DOCOL,ONE,TRAV,LIT16\r
-* FCB 5\r
- FCB NATWID*2+1\r
- FDB PLUS\r
- FDB SEMIS\r
-*\r
-* ######>> screen 40 <<\r
-* ======>> 104 <<\r
-* ( --- )\r
-* Save the parameter stack pointer in CSP for compiler checks.\r
- FCB $84\r
- FCC '!CS' ; '!CSP'\r
- FCB $D0\r
- FDB PFA-6\r
-SCSP FDB DOCOL,SPAT,CSP,STORE\r
- FDB SEMIS\r
-*\r
* ======>> 105 <<\r
* ( 0 n --- ) ( *** )\r
* ( true n --- IN BLK ) ( anything *** nothing )\r
OSDN Git Service
