.H Copyright (c) 1996, Gary D. Campbell NAME =MORE PREP,BODY,BACK,USAGE $$$$ CODE=01200 0000 PARMS (32) ----------- OTRAN ----------- 1200 PRIMITIVES ENTRY * indicates change w.r.t. PTRAN, + indicates Token 1200 =@P.A + [space] alpha [alpha|.|digit].. 1202 =@P.B S: Wrapup Prep, F: Initialize for Match(Body) 1204 =@P.C match a space & fall thru to P.D 1206 =@P.D bump SI past spaces, AF=0 1208 =@P.E RETURN: IF EndLine (AA=0); ELSE (NotEndLine CY=1). 120A =@P.F + [space] match file characters 120C =@CRASH * 120E =@CRASH * 1210 =@P.I +* [space] single char = `a..z{|}~? (FCN call) 1212 =@P.J Initialize Match(Prep), S: comment or null line. 1214 : 1214 : ALL PRIMITIVES HAVE 3 CHOICES (NOTE: $SP=RTN to SUC.MORE or DO.MORE): 1214 : 1. Emit a Token: CALL ERR.xx; =err,pfx; SI=BeginMatch; AA=Length 1214 : 2. Emit no Token: RTN SI=Match+1, AA=0 1214 : 3. Fail via CALL GET.RETRY; =err; (directly to SUC.MORE or DO.MORE) 1214 : 1214 CK.BYTE A=$SI+ RETURN SI=SI+1 only if 1 space skipped 1215* A:" " EQ: stopshort(space,space) 1217 IF EQ, LT: $SI = control character 1219 A=$SI GT: $SI = notany(space) 121B* A:" " 121D * IF NE,EXIT 121F ELSE SI=(SI-1) 1222 RTN: RETURN 1223 CK.A.NUM CALL CK.DEC.A 1226 IF NC,GOTO RTN 1228*CK.ALPHA A:"z"+1 122A IF LT, 122C* A:"a" 122E RETURN 122F.RTN.CY: CY=1 1230 RETURN 1231+FOLLOW.ON SI=SI+1 1232 A=$SI 1234* A:"." 1236 IF NE,GOTO CK.A.NUM 1238 PUSH SI 1239 CALL FOLLOW.ON 123C POP SI 123D RETURN 123E CK.DEC A=$SI+ RETURN: 123F*CK.DEC.A A:"9"+1 NC if in range 0-9 1241 IF GE,GOTO RTN.CY CY if outside this range 1243* A:"0" 1245 RETURN 1246 =32*0 .P 1266 ERR.CY IF NC, IF EITHER AA=SI or CY=1 1268 ERR.ZR SWAP AA,SI THEN GOTO GET.RETRY 1269* AA=AA-SI ELSE (AA>SI) 126B IF NZ, AA=Length, SI=@Source, CY=0 126D POP HL 126E CS: L=$(HL+1) Get Token pfx Code 1272 SWAP AA,HL 1273 $DI+=A Emit it. 1274 SWAP AA,HL Let SUC emit the 1275 RETURN (back to SUC) rest of the Token. 1276 GOTO GET.RETRY 1279 P.A CALL CK.BYTE [space] alpha [follow.on].. 127C PUSH SI 127D CALL CK.ALPHA 1280 IF NC, 1282 DO CALL FOLLOW.ON 1285 LOOP WHILE NC 1287. CY=0 1288 POP AA 1289 CALL ERR.CY 128C ="AA" 128E P.B PUSH SI 128F AA=%(SI+4) This primitive 1292* A:"=" SUCCEEDS if column (5,6) is "=" 1294 IF NE, and FAILS otherwise. 1296* A':"=" 1299 IF EQ, 129B SI=(SI+5) 129E POP AA 129F CALL ERR.ZR 12A2 ="=B" 12A4*P.C $SI:" " 12A7 IF EQ, 12A9 P.D DO A=$SI+ THIS PRIMITIVE CAN'T FAIL 12AA* A:" " It bumps SI past ALL Spaces 12AC LOOP WHILE EQ & returns AF=0. 12AE+ SI=SI-1 12AF*RTN.ZR: AA=0 AA=0,SI++ causes Success 12B1 RETURN & No Object Token 12B2 P.E CALL B.SOURCE THIS PRIMITIVE MATCHES SP,SP | CR 12B5+ SI=SI-1 12B6 IF NC,GOTO RTN.ZR (otherwise it fails) 12B8 CALL GET.RETRY 12BB ="E",20*0 .P 12D0 P.F CALL CK.BYTE [space] match file characters 12D3 PUSH SI Save index of 1st byte 12D4 DO CALL FILE.CHR 12D7* A'=A' XOR 5 12DA LOOP UNTIL NE check bytes until 1 byte too many 12DC+ SI=SI-1 BACKUP 1 12DD POP AA (NC, let ERR.CY detect FAIL=Null) 12DE CALL ERR.CY 12E1 ="FF" 12E3 P.I CALL CK.BYTE 12E6 PUSH SI 12E7* A:"~" 12E9 IF LE, Byte must be in range 12EB* A:"?" 3F, 60,61-7A, 7B-7E 12ED IF NE, ? ` a-z {|}~ 12EF* A:"`" 12F1 * IF LT,EXIT 12F3 CALL FOLLOW.ON (byte is in range) 12F6. CY=~CY disallow follow.on 12F7 POP AA (any alpha.num) 12F8 CALL ERR.CY 12FB ="aI" 12FD P.J CALL COMMENT.J This is the FIRST ALTERNATIVE OF PREP. 1300 IF LE, RETURN SUCCESS IF or EOF 1302* AA=0 1304 RETURN (Success) 1305 PUSH SI 1306 AA=%(SI+4) NE-->looking at BeginLine > 6. 1309* A:"=" (check for "=" in col 5/6) 130B IF NE, The following ALWAYS FAILS, since SI 130D* A':"=" is not bumped. 1310 * IF NE,EXIT 1312 ELSE HL=@CK.LIST-4 Here we "fixup" all 1315 A=$SI "prep" statements. 1317* A=A AND 5F This means rewriting 1319 DO HL=(HL+4) columns 1-4 if there 131C* CS: $(HL+4):0 is an "=" in 1321 * IF EQ,EXIT column 5 or 6. 1323* CS: A:$HL 1326 LOOP UNTIL EQ 1328 CS: AA=%HL 132B %SI=AA 132D CS: AA=%(HL+2) 1331 %(SI+2)=AA 1334* $(SI+5):"=" 1338 IF EQ, 133A $(SI+4)=" " 133E POP AA 133F CALL ERR.ZR 1342 ="=J",23*0 .P 135B COMMENT.C CALL SKIP.CR 135E IF ZR, 1360+ SI=SI-2 1362 COMMENT.J CALL EOF.COUNT Come here FROM: P.C & P.J 1365* AA:8 WITH: SI = 1368 IF GE, NEED: SI < CR,LF CY,NE 136A AA=%SI else, SI = same, NC,NE 136C* AA:"<<" SI < final CR,LF 136F IF EQ, (NC,EQ) 1371+ DO SI=SI+1 Always RETURN AA=0. 1372* SI:65520 1376 IF GE,CALL CRASH 137B AA=%SI 137D* AA:">>" 1380 * IF EQ,EXIT 1382* A:CR 1384 * IF NE,LOOP 1386 CALL EOF.COUNT 1389* AA:14 LF>>LFxxxx xLF[eof] 138C LOOP WHILE GE 138E * EXIT 1390* CS: A:$PERIOD 1395 * IF EQ,EXIT 1397 PUSH BC 1398 PUSH SI 1399 BC=6 139C DO A=$SI+ 139D* A:CR 139F * IF EQ,EXIT 13A1* A:":" 13A3 BC=BC-1 LOOP NE (BC>0) 13A5 POP SI RETURN: 13A6 POP BC Possible Good Statement 13A7 * IF EQ,EXIT O.K. = NC,NE (SI unchanged) 13A9. CY=0 EOF = CY,NE 13AA RETURN Comment = NC,EQ 13AB SKIP.CR DO A=$SI+ 13AC* SI:65520 13B0 IF GE,CALL CRASH 13B5* A:CR 13B7 LOOP UNTIL EQ 13B9+ SI=SI+1 13BA EOF.COUNT PUSH BC RETURN AA = MIN(65520, EndSource-SourcePtr) 13BB PUSH DE 13BC PUSH DI SI,DS = SourcePointer 13BD PUSH ES 13BE CS: DI,ES=%FILE.EOF 13C3 CALL PTR.DIFF 13C6 POP ES 13C7 POP DI 13C8 POP DE 13C9 POP AA 13CA SWAP AA,BC 13CB* AA:0 13CD RETURN 13CE =32*0 .P 13EC : Refer to: DS:PARMS+offset or %(BP+offset) 0002 EXIT=2 Exit Address for WRAPUP Error set by INIT.T 0004 ADDR=4 Initial ADDRESS of Statement 0006 SYM=6 SymTab Pointer from last lookup 0008 S.S=8 Source Segment 000A VECT=10 @Vector (upper SYMTAB segment) 000C TOKN=12 Token (FF80+) 000E FLAGS=14 =0 (INIT.P), =255 (1st INIT.B), =CY (2nd INIT.B FAILs) 13EE INIT.F ENTRY Initialize on behalf of entire source file 13EE AA=@E.O.CODE 13F1 %E.O.MEM=AA 13F4* AA=0 13F6 %ERR.CNT=AA 13F9 %PARMS+VECT=AA Initialize vector & token 13FC %PARMS+TOKN=@0FF7F 1402 CALL FILE.POINT 1405 SWAP ES,DS %(SI,DS) = . 1409 SWAP SI,DI %(DI,ES) = Symtab 1st entry 140B A=0FB Need Init Symtab = ,0 140D $DI+=A 0FB,0,0,,0 140E* AA=0 (pad w/Spaces) 1410 %DI+=AA 1411 DO $DI+=$SI+ 1412* $SI:"." 1415 LOOP UNTIL EQ 1417 AA=" " 141A %DI+=AA 141B %DI+=AA 141C %DI+=AA 141D %DI+=AA 141E* AA=0 1420 DI=0B 1423 %DI+=AA 1424 ES=CS 1426 RETURN 1427 NEXT.LINE ENTRY 1427 CS: SI,DS=%FILE.PTR Get pointers positioned 142C CALL EOF.COUNT for another line of source. 142F SWAP AA,BC RTN CY if too near the EOF. 1430 DO UNTIL BC=0 1432 A=$SI+ 1433* A:CR 1435 BC=BC-1 LOOP NE (BC>0) 1437+ SI=SI+1 LFxxxx xLF 1438 CALL MIN.SI ^BC------^EOF 143B AA=DS (min = 9) 143D DS=CS 143F* BC:9 1442 IF GE, 1444 %FILE.PTR+2=AA 1447 %FILE.PTR=SI 144B RETURN 144C PATCH PUSH SI substituted for CALL EOF.COUNT 144D DO A=$SI+ 144E CALL DISPLAY.A 1451* A:LF 1453 LOOP UNTIL EQ 1455 CALL WAIT.INPUT 1458 POP SI 1459 GOTO EOF.COUNT 145C WAIT.INPUT A=-1 145E DISPLAY.A PUSH AA 145F PUSH DE 1460 E=A 1462 A'=6 1464 INT 021 1466 POP DE 1467 POP AA 1468 RETURN 1469 =3*0 .P 146C CK.LIST: ="NAME",19*0 1483 INIT.P ENTRY Initialize before call MATCH(prep) 1483 BP=@PREP 1486 DE=(BP+2) 1489 BP=%BP 148C AA=%TOKENS+2 148F ES=AA ES = Token Segment 1491* AA=0 DI will Index EOF of Tokens (until WRAPUP) 1493 %PARMS+FLAGS=AA 1496 SWAP AA,DI DI,ES = Match Object (Token Stream) 1497 SI,DS=%FILE.PTR SI,DS = Match Source 149B CS: %MAX.SRC=SI 14A0 CS: %COLUMN1=SI 14A5 RETURN 14A6 INIT.B ENTRY Initialize before call MATCH(body) 14A6 DS=CS 14A8 BP=@BODY 14AB DE=(BP+2) 14AE BP=%BP 14B1* $PARMS+FLAGS=$PARMS+FLAGS+255 14B6 IF NC, 14B8 SI,DS=%FILE.PTR 14BC CS: AA=%OBJECT 14C0 CALL WRITE.HEX 14C3+ SI=SI+1 14C4. CY=0 14C5 RETURN 14C6 INIT.T ENTRY 14C6 BP=@PARMS 14C9 CS: AA=%OBJECT 14CD %(BP+ADDR)=AA Initialize ADDR for cross reference 14D0 HL=@BACK 14D3 %BP=HL %BP=@BACK Subpatterns 14D6 CS: HL=%HL HL=%BACK (1st Pattern) 14D9 SWAP DE,DI DE=End-of-Tokens 14DB* DI=0 14DD %(BP+EXIT)=SP Set an Exit Address 14E0 CS: %FILE.PTR=SI Update SourcePtr; can't BACKUP now 14E5 %(BP+S.S)=DS Save the Source Segment Register 14E8 RETURN 14E9 =34*0 .P 150B FAIL.WRAP POP SI Code this page is identical to PTRAN. 150C CS: A=$SI 150F CS: $ERR.FLG=A 1513 F.E: SP=%(BP+EXIT) 1516 ERROR ENTRY CALLED from TRANSLATE or WRAPUP. 1516 CS: DS=%FILE.PTR+2 When both MATCH(prep) and MATCH(body) 151B CS: SI=%COLUMN1 OR WRAPUP can't handle statement. 1520 AA=%(SI+4) (columns 5-6) 1523* A:"=" Kxxx=arb 1525 IF NE, Knn?=arb 1527* A':"=" Kxxx =arb 152A * IF NE,EXIT K nn?=arb 152C+ SI=SI+1 152D $SI=" " 1530+ ELSE SI=SI+1 (column 2/3) 1531 ERR.1: %(SI+2)="?=" (columns 4/5-5/6) 1536 CS: AA=%MAX.SRC 153A* CS: AA=AA-%COLUMN1 153F* AAM A'=10's, A=1's (Decimal Number) 1541* AA=AA OR "00" 1544 SWAP A,A' 1546* A:"9" 1548 IF GT, 154A A="9" (max=99) 154C %SI=AA 154E CS: A=$ERR.CNT 1552* A=A+01 1554* DAA Keep a BCD ERR.CNT 1555 IF CY, 1557 A=099 (max=99) 1559 CS: $ERR.CNT=A 155D RETURN 155E CS: A=$ERR.FLG xxxx+label 1562 $(SI+4)=A nn?=xlabel 1565 GOTO ERR.1 1567 =65*0 .P 15A8 FUNCTIONS ENTRY 15A8 =@CRASH not used 15AA =@F.A a.num (emit pattern reference) 15AC =@F.B handle byte constants (based on Emit-1) 15AE =@F.C primitive function call `a..z{|}~? 15B0 =@F.D a.num (define pattern) 15B2 =@F.E error (same as ptran) 15B4 =@F.F filename (same as ptran) 15B6 =30*0 15D4 F.C: CALL GET.TOKEN 15D7 A=$SI+ 15D8* A=A OR 060 15DA GOTO EMIT.A 15DD GET.TOKEN DS=%(BP+S.S) 15E0 ES: SI=%(DI+2) 15E4 PUSH %(SI+1) 15E7 CS: POP %MAX.SRC 15EC ES: C=$(DI+1) 15F0 B=0 15F2 RETURN 0020 TEMP (16) 15F3 BUFFER NEXT 15F3* BC:10 MaxSymbolLength=10 15F6 IF GT, 15F8 BC=10 15FB PUSH BC BC = Length; SI,DS = Raw Source 15FC ES=CS 15FE DI=@TEMP 1601 PUSH DI 1602 DO CALL FILE.CHR 1605 $DI+=A 1606 BC=BC-1 LOOP (BC>0) 1608 DS=CS 160A POP SI SI,DS = @Buffer (Shifted Source) 160B POP BC BC = Length 160C RETURN 160D =32*0 .P 162D LOOKUP NEXT 162D DI,ES=%SYMTAB SI,DS = @Buffer (Symbol) (DS=CS) 1631 SWAP AA,BC BC was Length of Symbol (max=10) 1632 PUSH DI 1633 DO POP DI 1634 ES: C=$DI Here, A=Len 1637* BC=BC AND 0F 163B* DI=DI+BC 163D ES: C=$DI 1640* C=C AND 0F 1643* C:1 1646 PUSH DI 1647 * IF LT,EXIT 1649 DI=(DI+3) 164C* C=C-3 164F* A:C Are lengths equal? 1651 * IF NE,LOOP (if not, symbols can't be equal) 1653 PUSH SI 1654 DO UNTIL BC=0 * $SI+:$DI+ BC=BC-1 LOOP EQ (BC>0) 1656 POP SI 1657 LOOP WHILE NE 1659 SWAP AA,BC BC=Length of Symbol 165A POP DI 165B %(BP+SYM)=DI EQ-->Symbol Found (%DI=[k l] Value) 165E RETURN NE-->End-of-Table (%DI=[0]) 165F ENTER NEXT 165F ES=%SYMTAB+2 H=Key (LS4 bits = 0) Must be called after 1663 DI=%(BP+SYM) BC=Symbol Length; LOOKUP fails. 1666 ENTER.DI NEXT 1666 PUSH DI AA = Value (Token) 1667+ DI=DI+1 SI,DS = @Buffer (Symbol to be entered) 1668 %DI+=AA 1669 DO UNTIL BC=0 $DI+=$SI+ DO NOT USE THIS ROUTINE BC=BC-1 TO ENTER A FILENAME (key=F) LOOP (BC>0) 166B ES: %DI=BC End-of-Table = @0-word 166E POP AA Index of Skip Byte 166F SWAP AA,DI now, AA = Index of 0-Byte 1670* AA=AA-DI now, DI = Begin Entry & A = Length of Entry 1672* A=A OR H combine key & skip 1674 $DI+=A and fix the [key skip] byte. 1675 RETURN (MUST RETURN NC) 1676 =32*0 .P 1696 F.A: PUSH HL 1697 PUSH DI 1698 PUSH ES 1699 CALL GET.TOKEN 169C CALL BUFFER 169F CALL LOOKUP 16A2 IF NE, 16A4 CALL NEW.TOKN 16A7 CALL NEW.VECT 16AA CALL EMIT.A 16AD H=080 16AF NEW.ONE: CALL ENTER 16B2 POP.ONE: POP ES 16B3 POP DI 16B4 POP HL 16B5 RETURN 16B6 ES: AA=%(DI+1) otherwise, get AA = Ref Token 16BA CALL EMIT.A 16BD GOTO POP.ONE 16BF F.D: PUSH HL CALLED WITH: [:] 16C0 PUSH DI 16C1 PUSH ES 16C2 CALL GET.TOKEN 16C5 CALL BUFFER is in BUFFER, BC=Length 16C8 CALL LOOKUP 16CB AA=%(BP+ADDR) 16CE IF NE, 16D0 CALL NEW.VECT Emit 1st vector element. 16D3 CALL NEW.TOKN 16D6 H=060 And Enter a local symbol. 16D8 GOTO NEW.ONE 16DA DS=ES 16DC* $DI::`0 Found symbol, is it marked 16DF IF ZR, as forward ref? 16E1 CALL FAIL.WRAP No, it must be a 16E4 ="D" Duplicate Definition 16E5* $DI=$DI AND 0F yes, key = forward ref. 16E8* $DI=$DI OR 060 now, change key to "local" 16EB PUSH AA 16EC A=$(DI+1) 16EF* A=A+A 16F1 A'=0 16F3* AA=AA+%(BP+VECT) 16F6 POP DI 16F7 SWAP AA,DI 16F8 %DI=AA 16FA GOTO POP.ONE 16FC =51*0 .P 172F NEW.VECT DS=%SYMTAB+2 Enter with: 1733 DI=%(BP+VECT) AA=New Address 1736+ DI=DI-2 BP=@PTRS, DS=CS 1738 %(BP+VECT)=DI 173B+ DO DI=DI+2 Move Vector 2 bytes down & put 173D * IF ZR,EXIT New Address into last location. 173F PUSH %DI 1741 POP %(DI-2) 1744 LOOP 1746 %(DI-2)=AA Need to RETURN: 1749 DS=CS AA,BC,SI unchanged. 174B RETURN DI=0, DS=CS 174C GET.OPT PUSH AA 174D ES: AA=%(DI+2) 1751 DI=(DI+4) 1754* AA:DI 1756 POP AA 1757 IF EQ, 1759. CY=1 175A RETURN 175B GET.B CALL GET.TOKEN (insure MAX.SRC set for error) 175E* ES: $DI:0 AA,DE,HL unchanged. 1762 DI=(DI+4) (skip DI past tokens) 1765 ES: B=$DI Return B = h | hh 1768 IF NE, 176A* ASL B,4 176D DI=(DI+4) 1770* ES: B=B OR $DI 1773 DI=(DI+4) 1776 RETURN 1777 NEW.TOKN AA=%(BP+TOKN) 177A+ A=A+1 177C IF ZR, 177E CALL FAIL.WRAP 1781 =">" 1782 $(BP+TOKN)=A 1785 RETURN 1786 =48*0 .P 17B6 F.B: CALL GET.EMIT 17B9 A=$(SI-1) $(Object-1) = 1,0D,10,30-50, or 80. 17BC* A:080 17BE IF EQ, (80) XOR [b][b] 17C0 CALL GET.OPT 17C3 IF CY, 17C5 B=0F 17C7 CALL GET.EMIT 17CA* B:0F 17CD IF GT, 17CF F.BAD: CALL FAIL.WRAP 17D2 =">" 17D3* $(SI-1)=$(SI-1) OR B 17D6 CALL GET.OPT 17D9 IF NC, 17DB* B:7 17DE IF GT,GOTO F.BAD 17E0* ASL B,4 17E3 CALL GET.EMIT 17E6* $(SI-1)=$(SI-1) OR B 17E9 F.RTN: RETURN 17EA CALL GET.B is now in B, Token Pointer is bumped. 17ED* A:010 17EF IF GT, 17F1 CALL GET.EMIT (30-50) $<=> b 17F4* B:0F 17F7 IF GE, 17F9* $(SI-1)=$(SI-1) OR 0F 17FD IF LT, 17FF* B=B OR $(SI-1) 1802+ CS: %OBJECT=%OBJECT-1 1807 F.EMB: A=B 1809 GOTO EMIT.A 180C IF EQ, (10) $b=b[b] 180E CALL F.EMB 1811 CALL GET.OPT 1814 IF CY,GOTO F.RTN 1816 CALL GET.EMIT 1819* $(SI-2)=$(SI-2) XOR 030 181D GOTO F.EMB 181F* A:0D 1821 IF EQ,GOTO F.EMB (0D) XOR b 1823 CALL F.EMB (01) Emit: b[b][b][b][b][b] 1826 CALL GET.EMIT 1829+ SI=SI-2 182B A'=5 182D DO PUSH DS 182E PUSH SI 182F CALL GET.OPT 1832 POP SI 1833 POP DS 1834 IF NC, 1836 CALL F.EMB 1839+ $SI=$SI+1 183B+ A'=A'-1 183D LOOP UNTIL ZR 183F RETURN 1840 =32*0 .P 1860 F.F: PUSH DE 1861 PUSH HL 1862 PUSH DI 1863 PUSH ES 1864 CALL GET.TOKEN Handle NAME= 1867 CALL BUFFER 186A CS: ES=%SYMTAB+2 186F DI=3 Index to Root NAME entry. 1872 PUSH SI 1873 PUSH BC 1874* BC:8 1877 IF GT, Truncate to 8 characters. 1879 BC=8 187C DO UNTIL BC=0 $DI+=$SI+ BC=BC-1 Overwrite with new NAME= LOOP (BC>0) 187E* DO DI:11 1881 * IF GE,EXIT 1883 ES: $DI=" " 1887+ DI=DI+1 Pad with Spaces if necessary. 1888 LOOP 188A POP BC 188B POP SI 188C POP ES 188D POP DI 188E POP HL 188F POP DE 1890 RETURN 1891*SYM.FIX %OBJECT:0 1896 SI=@EMPTY Aborts if OBJECT=0 1899 IF EQ,GOTO DSPLY 189D BP=@PARMS 18A0 SI,DS=%SYMTAB FIX SymTab(0B); Value always = @0 18A4* $0B=$0B XOR 040 change Type from 06x to 02x 18A9 MAP.IT CS: ES=%SYMTAB+2 Get Regs: 18AE DI=%(BP+VECT) DI,ES = Vector (at high SYMTAB) 18B1* A=A+A 18B3 A'=0 18B5* AA=AA+DI AA = Token for symbol 18B7 SWAP AA,DI RETURN WITH: 18B8 ES: DI=%DI AA = Address (or unchanged) 18BB SWAP AA,DI Only other regs changed = DI,ES. 18BC RETURN 18BD =32*0 .P 18DD FINAL ENTRY 18DD DS=CS 18DF* $ERR.CNT:0 18E4 IF ZR, AF = ERR.CNT (IF count > 0, quit) 18E6 CALL SYM.FIX 18E9 DO C=$SI 18EB* BC=BC AND 0F 18EF * IF ZR,EXIT 18F1* SI=SI+BC 18F3 AA=%(SI+1) 18F6* A':-1 18F9 * IF NE,LOOP 18FB CALL MAP.IT 18FE* A':-1 1901 IF EQ,CALL NO.DEF 1906 %(SI+1)=AA 1909 LOOP 190B+ SI=SI+2 190D PUSH SI 190E SI=DI 1910* DO %SI=%SI-DI 1912+ SI=SI+2 1914 LOOP UNTIL ZR 1916 POP SI 1917 CALL E.VECTOR 191A CS: BC,DS=%OBJECT 191F* SI=0 1921 DO A=1 1923 HL=DI 1925 $DI+=A 1926 DO $DI+=$SI+ 1927+ A=A+1 1929 ES: $HL=A 192C* A:63 192E BC=BC-1 LOOP NE (BC>0) 1930+ BC=BC+1 1931 BC=BC-1 LOOP (BC>0) 1933* AA=0 1935 $DI+=A 1936 DS=CS 1938 ES=CS 193A A=$ERR.CNT 193D* A:0 193F RETURN AF = ERR.CNT 1940 =60*0 .P 197C E.VECTOR SWAP SI,DI 197E A=3 1980 $DI+=A 1981* AA=0 1983 %DI+=AA 1984 DO A=`3 1986 $DI+=A 1987 %DI+=%SI+ 1988* SI:0 198A LOOP UNTIL EQ 198C RETURN 198D NO.DEF C=$SI 198F PUSH DS 1990 PUSH ES 1991 PUSH SI 1992 PUSH DI 1993 PUSH AA 1994 SI=(SI+3) 1997* C=C-3 199A* BC=BC AND 0F 199E DI=5D 19A1 ES=CS 19A3 DO UNTIL BC=0 $DI+=$SI+ BC=BC-1 LOOP (BC>0) 19A5 CS: $DI=0 19A9 SI=@NO.DEF.1 19AC CALL DSPLY 19AF+ $ERR.CNT=$ERR.CNT+1 19B3 POP AA 19B4 POP DI 19B5 POP SI 19B6 POP ES 19B7 POP DS 19B8 RETURN 19B9 NEXT . 120C CRASH 1276 GET.RETRY 12B2 B.SOURCE 12D4 FILE.CHR 1382 CR 1390 PERIOD 13BE FILE.EOF 13C3 PTR.DIFF 13EE E.O.CODE 13F1 E.O.MEM 13F6 ERR.CNT 1402 FILE.POINT 1427 FILE.PTR 1438 MIN.SI 1451 LF 1483 PREP 148C TOKENS 149B MAX.SRC 14A0 COLUMN1 14A8 BODY 14BC OBJECT 14C0 WRITE.HEX 14D0 BACK 150F ERR.FLG 15DA EMIT.A 162D SYMTAB 17B6 GET.EMIT 1896 EMPTY 1899 DSPLY 19A9 NO.DEF.1