On Monday, April 21, 2014 11:23:35 AM UTC-5, Didier VALLET wrote:
>
>
>
> Hello, it's crazy.
>
> You've done more in a few days than i'm able to understand about your job.
>
> At the start, i've try like you to see if some routines are the same in the 2 versions of wizardry.
>
> And on an other hand, i'm looking to make a new version of wiz3 (and wiz1 first, that's the reason for me to get the source code of it) on Oric1 and Apple based on C code. It's quite difficult to understand where is starting wiz3 code in your source because there's a lot of lines and datas aren't linked to the code.
Hi Didier,
I will assume when you are asking for information about "wiz3 code" that you are referring to my program written in Applesoft Basic to take a diskette with compiled Pascal code and display the formatted pcode output.
At the end of this message I will include the source code for this "wiz3" program. To try to stop confusion about the names I am usually now calling the "wiz3" basic program "DeCompiler" (wiz3 is too similar to Wizardry III or Wizardry3).
The code for DeCompiler is not pretty, and not my best coding effort, but as a small tool it definitely made life easier for me 25 years ago and 2 years ago, and today.
DeCompiler is used to display pcode for any Pascal (1.1) diskette which contains pcode. It is not specifically written for Wizardry diskettes.
There are 2 main paths in the DeCompiler. One is if you want the program to decompile all the files and all the procedures on a diskette. The other main path is if you are interested in one particular decompiled procedure on the diskette.
These 2 mainlines are similar. The code to display "ALL" files starts at line 5100, and for just one file at line 5000.
The routine at line 5 sets up the RWTS routine in memory at $9500 as 6502 code. At line 80 is the subroutine that is called to use RWTS to read a sector of information from the diskette in drive 2 of slot 6. As noted, this routine requires input in the array RW as follows:
RW(0) : Track number
RW(1) : Sector number
RW(2) : Buffer pointer (insignificant byte)
RW(3) : Buffer pointer (significant byte)
At line 100 is code to read the Pascal Directory into memory at $8D00 to $94FF. That's 8 sectors of 256 bytes or 4 Pascal blocks.
http://code.google.com/p/profuse/wiki/PascalFileSystem is a good reference describing the Pascal directory structure.
At line 140 we look in the Pascal directory looking for files. We display the file index and the filename.
At line 200 we get the file index for the file that contains the code you are interested in. (Typing "-1" ends the program.)
Starting at line 210 we use the file index to point to the file entry in the directory. At line 212 we examine this file entry to see if it is either a Pascal Code file, or the file "SYSTEM.LIBRARY". Both of those contain pcode.
At line 217 we display the Track/Sector where the file begins on the diskette. All Pascal files written to a diskette occupy one contiguous sequence of blocks. There are no "gaps" and the file is not spread out in smaller pieces about the diskette. The information for sector is displayed in 2 formats: DOS and PASCAL. DOS and PASCAL use different numbering for sectors.
Line 222 sets up to read the "Segment sector" to $8C00 in memory. This is the "Segment Dictionary" as described in the Apple Pascal Operating System. It is described in the section "Operation of P-machine".
When interested in one procedure, we now ask for the "Segment Number" where the code resides that you are interested in. Entering "-1" takes you back to the previous prompt.
At line 285 we calculate the Track and Sector to be able to read the selected Segment into memory. The comment at line 333 says it is read into the Apples memory at $4000, but that is an old comment. It is actually read into memory at $5000.
At line 375 we ask for the address ($5000 is default) that we want to use for the segments "load address". The segment is always read into memory at $5000, but by typing a different number here, you can get different relative addresses displayed by the DeCompiler. For example, if you enter $5400, then the first instruction will be labeled $5400 and not $5000. Usually you will just want to use the default of $5000.
At line 390 we display the count of the number of PROCEDURES in this SEGMENT.
At line 420 you enter the procedure number you are interested in. Entering "-1" takes you back to a previous prompt.
At line 440 we calculate where the PROCEDURE begins in the segment.
At line 460 we display the JTAB for this procedure.
At line 480 we begin the process of de-compiling the code in the procedure. The variable P8 is similar to the "program counter" and P9 is the contents that we find at the memory pointed to by P8.
From there it is one giant case statement to process each of the different pcode instructions that are possible in P9.
If you (or anyone) needs more help in understanding "wiz3" (DeCompiler) let me know and I will try to help.
Tom Ewers (aka TommyGOOG)
As promised, here is the Basic code for the DeCompiler:
PR#1
]POKE 33,33
]LIST
1 INPUT "PROCESS ALL?";XX$
2 IF XX$ = "Y" THEN 5100
3 GOTO 5000
5 RW = 9 * 16 ^ 3 + 5 * 16 ^ 2
6 HH = 5
7 HM = HH * 16 ^ 3
10 HIMEM: HM
20 DATA A9,95,A0,09,20,D9,03,60,00,01,60,02,00,12,06,1A,95,00,40,00,00,01,00,00,60,01,00,01,EF,D8,00
30 FOR X = 0 TO 29
40 READ A$
60 A1$ = LEFT$ (A$,1)
61 A2$ = RIGHT$ (A$,1)
62 A1 = 16 * ( ASC (A1$) - ASC ("A") + 10)
63 IF A1$ < "A" THEN A1 = 16 * ( ASC (A1$) - ASC ("0"))
64 A2 = ASC (A2$) - ASC ("A") + 10
65 IF A2$ < "A" THEN A2 = ASC (A2$) - ASC ("0")
66 POKE RW + X,A1 + A2
70 NEXT X
71 READ A$
75 RETURN
80 POKE RW + 13,RW(0): REM TRACK NUMBER
81 POKE RW + 14,RW(1): REM SECTOR
82 POKE RW + 17,RW(2): REM LOW BUFF
83 POKE RW + 18,RW(3): REM HIGH BUFF
90 CALL 9 * 16 ^ 3 + 5 * 16 ^ 2
92 RETURN
100 RW(0) = 0
104 Y = 0
105 FOR X = 11 TO 4 STEP - 1
106 RW(1) = X
108 RW(2) = 0
109 RW(3) = 8 * 16 + 13 + Y
110 GOSUB 80
115 Y = Y + 1
120 NEXT X
130 DD = 8 * 16 ^ 3 + 13 * 16 ^ 2: REM DIR AT $8D00
132 FC = PEEK (DD + 16): PRINT "FILES: ";FC
133 FX = 0
135 RETURN
140 PRINT :FQ(1) = 0: REM FQ(1)=HIGHEST FILE INDEX
141 FOR X = 1 TO 77
142 D1 = DD + 26 * X: REM D1 = FILE ENTRY ADDRESS
143 IF FX > = FC THEN 198
145 IF PEEK (D1 + 4) = 0 THEN 198
146 IF PEEK (D1 + 4) > 5 THEN 198
147 PRINT X;" ";
150 FOR Y = 0 TO PEEK (D1 + 6) - 1
155 PRINT CHR$ ( PEEK (D1 + 7 + Y));
160 NEXT Y
161 FX = FX + 1
165 PRINT
167 FQ(1) = X
198 NEXT X: PRINT
199 RETURN
200 REM
201 INPUT "TYPE A FILE NUMBER (OR -1) ";FF
202 PRINT
203 RETURN
210 D1 = DD + 26 * FF: REM D1 POINTS TO FILE ENTRY IN DIRECTOR
211 T2$ = "": FOR X = 0 TO 13:T2$ = T2$ + CHR$ ( PEEK (D1 + 7 + X)): NEXT
212 FQ(4) = 0: IF ( PEEK (D1 + 4) < > 2) AND (T2$ < > "SYSTEM.LIBRARY") THEN FQ(4) = - 1: RETURN : REM FILEKIND, 2==CODEFILE
214 T1 = PEEK (D1 + 0):T2 = PEEK (D1 + 1): REM SEG T/S INFO. 5/3/1 FORMAT
215 T = INT (T1 / 8) + (T2 / 2 < > INT (T2 / 2)) * 32
216 S = (T1 - INT (T1 / 8) * 8) * 2
217 PRINT "SEGMENT T/S = ";T;"/";S;" --- PASCAL T/S"
218 IF S < > 15 AND S < > 0 THEN S = 15 - S
219 PRINT "SEGMENT T/S = ";T;"/";S;" --- DOS 3.3 T/S"
220 PRINT
221 RW(0) = T:RW(1) = S
222 RW(2) = 0:RW(3) = 8 * 16 + 12: REM READ SEGMENT SECTOR TO $8C00
225 GOSUB 80
235 SS = 8 * 16 ^ 3 + 12 * 16 ^ 2: REM SEG DICTIONARY AT BEGIN OF FILE
240 FOR X = 0 TO 15
241 IF PEEK (SS + 4 * X) = 0 AND PEEK (SS + 4 * X + 1) = 0 AND PEEK (SS + 4 * X + 2) = 0 AND PEEK (SS + 4 * X + 3) = 0 THEN 257
242 PRINT X;" ";
243 FQ(2) = X
245 FOR Y = 0 TO 7
250 PRINT CHR$ ( PEEK (SS + 64 + 8 * X + Y));
255 NEXT Y
256 PRINT
257 NEXT X
260 RETURN
280 PRINT
281 INPUT "TYPE A SEGMENT NUMBER (OR -1) ";SS
282 PRINT : IF SS > FQ(2) THEN 281
283 RETURN
285 S1 = 8 * 16 ^ 3 + 12 * 16 ^ 2 + SS * 4: REM CALC SEGMENT POINTER START FOR SS
290 T3 = PEEK (S1)
291 T4 = PEEK (S1 + 1)
295 T5 = T1 + T3
299 T6 = 0
300 IF T5 > 255 THEN T5 = T5 - 256:T6 = 1
302 T6 = T2 + T4 + T6
303 T = INT (T5 / 8) + (T6 / 2 < > INT (T6 / 2)) * 32
304 S = (T5 - INT (T5 / 8) * 8) * 2
305 SD = S
306 IF S < > 15 AND S < > 0 THEN SD = 15 - S
315 PRINT "T/S FOR SEGMENT ";T;"/";S;" --- PASCAL"
316 PRINT "T/S FOR SEGMENT ";T;"/";SD;" --- DOS "
320 LL = PEEK (S1 + 3) + ( PEEK (S1 + 2) < > 0)
322 IF LL = 0 THEN RETURN
330 RW(0) = T
331 RW(1) = SD
332 RW(2) = 0
333 RW(3) = HH * 16: REM $4000 IS WHERE SEGMENT IS READ INTO
340 FOR X = 0 TO (LL - 1)
350 GOSUB 80: REM READ A SECTOR
360 IF RW(1) = 1 THEN RW(1) = 15: GOTO 370
361 IF RW(1) = 15 THEN RW(1) = 0:RW(0) = RW(0) + 1: GOTO 370
362 IF RW(1) = 0 THEN RW(1) = 14: GOTO 370
363 RW(1) = RW(1) - 1
370 RW(3) = RW(3) + 1
371 NEXT : PRINT
372 RETURN
375 INPUT "SEGMENT'S START ADDR($5000):";A$
376 IF LEN (A$) = 0 THEN 387: REM 0 TO ADD TO P8
377 IF LEN (A$) > 4 THEN 375
379 FOR X = 0 TO LEN (A$) - 1
380 A1$ = MID$ (A$, LEN (A$) - X,1)
381 A1 = 16 * ( ASC (A1$) - ASC ("A") + 10)
382 IF A1$ < "A" THEN A1 = 16 * ( ASC (A1$) - ASC ("0"))
383 PA = PA + (16 ^ (X - 1)) * A1
385 NEXT X
386 PA = PA - HM
387 RETURN
390 PRINT
400 P1 = HH * 16 ^ 3 + PEEK (S1 + 3) * 16 ^ 2 + PEEK (S1 + 2) - 1: REM LAST BYTE IN SEGMENT IS "PROCEDURE COUNT"
410 P2 = PEEK (P1): REM P2 = NUMBER OF PROCEDURES IN SEGMENT
412 FQ(3) = P2
415 PRINT "THERE ARE ";P2;" PROCEDURES."
417 PRINT
418 RETURN
420 PRINT
421 INPUT "ENTER PROCEDURE # (OR -1) ";P3: REM P3 = PROCEDURE NUMBER
422 PRINT
425 IF P3 = - 1 THEN RETURN
430 IF P3 > P2 OR P3 < 1 THEN 420
435 RETURN
440 P4 = P1 - 2 * P3 - 1: REM P4=PTR TO SUBROUTINE POINTER
450 P5 = P4 - PEEK (P4 + 1) * 16 ^ 2 - PEEK (P4) - 8: REM P5=PTR TO BEGIN OF SUBROUTINE'S JTAB
459 PRINT
460 PRINT "JTAB FOR SUBROUTINE ";P3;":"
462 PRINT "DATA SIZE: "; PEEK (P5) + PEEK (P5 + 1) * 16 ^ 2
464 PRINT "PARAM SIZE: "; PEEK (P5 + 2) + PEEK (P5 + 3) * 16 ^ 2
465 P6 = P5 + 4 - ( PEEK (P5 + 4) + PEEK (P5 + 5) * 16 ^ 2): REM P6=EXIT ADDRESS
466 PRINT "EXIT AT: ";:A = P6 + PA: GOSUB 550: PRINT A$
467 P7 = P5 + 6 - ( PEEK (P5 + 6) + PEEK (P5 + 7) * 16 ^ 2): REM P7=START ADDRESS
468 PRINT "ENTER AT: ";:A = P7 + PA: GOSUB 550: PRINT A$
470 PRINT "PROC NUMBER: "; PEEK (P5 + 8)
472 IF PEEK (P5 + 8) = 0 THEN PRINT "6502 CODE": RETURN
475 PRINT "LEXICAL LEVEL: "; PEEK (P5 + 9)
477 REM RETURN
480 P8 = P7: REM P8 IS THE PROGRAM-COUNTER
500 P9 = PEEK (P8): REM P9=CONTENTS AT PC
501 IF P8 > = P5 THEN RETURN
502 A = P8 + PA: GOSUB 550: PRINT A$;" ";
503 A = P9: GOSUB 550: PRINT RIGHT$ (A$,2);" ";
510 IF P9 < 128 THEN 1000
520 ON P9 - 127 GOTO 1280,1290,1300,1310,1320,1330,1340,1350,1360,1370,1380,1390,1400,1410,1420,1430,1440,1450,1460,1470,1480,1490,1500,1510,1520,1530,1540,1550,1560,1570,1580,1590,1600,1610,1620,1630,1640,1650,1660,1670,1680,1690,1700
522 ON P9 - 170 GOTO 1710,1720,1730,1740,1750,1760,1770,1780,1790,1800,1810,1820,1830,1840,1850,1860,1870,1880,1890,1900,1910,1920,1930,1940,1950,1960,1970,1980,1990,2000,2010,2020,2030,2040,2050,2060,2070,2080,2090,2100
524 ON P9 - 210 GOTO 2110,2120,2130,2140,2150,2160,2170,2180,2190,2200,2210,2220,2230,2240,2250,2260,2270,2280,2290,2300,2310,2320,2320,2320,2320,2320,2320,2320,2320,2320,2320,2320,2320,2320,2320,2320,2320,2480,2480,2480
526 ON P9 - 250 GOTO 2480,2480,2480,2480,2480
530 PRINT
531 P8 = P8 + 1: GOTO 500
532 P8 = P8 + 2: GOTO 500
533 P8 = P8 + 3: GOTO 500
534 P8 = P8 + 4: GOTO 500
550 REM A=DECIMAL NUMBER. RETURNS A$=4 DIGIT HEX NUMBER
551 A$ = ""
552 FOR A1 = 3 TO 0 STEP - 1
555 A2 = INT (A / 16 ^ A1)
556 A = A - A2 * 16 ^ A1
557 IF A2 > 9 THEN A$ = A$ + CHR$ ( ASC ("A") + A2 - 10): GOTO 559
558 A$ = A$ + CHR$ ( ASC ("0") + A2)
559 NEXT
560 RETURN
1000 PRINT " SLDC. PUSH #";:A = P9: GOSUB 550: PRINT A$
1001 GOTO 531
1100 REM GIVEN B1 DETERMINE "B"IG AND PRINT IT (SPLIT RAW FORMAT)
1102 A = PEEK (B1): GOSUB 550: PRINT RIGHT$ (A$,2);" ";
1103 IF PEEK (B1) > 127 THEN A = PEEK (B1 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" ";: RETURN
1104 PRINT " ";: RETURN
1119 REM GIVEN B1 DETERMINE "B"IG AND PRINT IT (XX OR XXXX)
1120 B = PEEK (B1): IF B > 127 THEN B = ( PEEK (B1) - 128) * 256 + PEEK (B1 + 1)
1121 A = B: GOSUB 550: PRINT RIGHT$ (A$,2 + 2 * (B > 255));
1122 RETURN
1130 IF B1 > 127 THEN 532
1131 GOTO 531
1280 PRINT SPC( 9);"ABI. PUSH ABS( (TOS) ) )
1281 GOTO 531
1290 PRINT SPC( 9);"ABR. PUSH ABS( (TOS) ) )
1291 GOTO 531
1300 PRINT SPC( 9);"ADI. PUSH ((TOS) + (TOS-1))
1301 GOTO 531
1310 PRINT SPC( 9);"ADR. PUSH ((TOS) + (TOS-1))
1311 GOTO 531
1320 PRINT SPC( 9);"LAND. PUSH ((TOS-1) AND (TOS))
1321 GOTO 531
1330 PRINT SPC( 9);"DIF. DIFFERENCE OF SETS (TOS) AND (TOS-1)": GOTO 531
1340 PRINT SPC( 9);"DVI. PUSH ((TOS-1) / (TOS))
1341 GOTO 531
1350 PRINT SPC( 9);"DVR PUSH ((TOS-1) / (TOS))
1351 GOTO 531
1360 PRINT SPC( 9);"CHK. IF (TOS-1) <= (TOS-2) <= (TOS) THEN PUSH TOS-2 ELSE ERROR
1361 GOTO 531
1370 PRINT SPC( 9);"FLO. PUSH ( REAL(TOS-1))
1371 GOTO 531
1380 PRINT SPC( 9);"FLT. PUSH ( REAL(TOS) )
1381 GOTO 531
1390 PRINT SPC( 9);"INN. PUSH TRUE IF (TOS-1) IN SET (TOS)": GOTO 531
1400 PRINT SPC( 9);"INT. INTERSECTION OF SETS (TOS) AND (TOS-1)": GOTO 531
1410 PRINT SPC( 9);"LOR. PUSH ((TOS-1) OR (TOS))
1411 GOTO 531
1420 PRINT SPC( 9);"MODI. PUSH ((TOS-1) MOD (TOS))
1421 GOTO 531
1430 PRINT SPC( 9);"MPI. PUSH ((TOS-1) * (TOS))
1431 GOTO 531
1440 PRINT SPC( 9);"MPR. PUSH ((TOS) * (TOS))
1441 GOTO 531
1450 PRINT SPC( 9);"NGI. PUSH -(TOS) (2'S COMP)
1451 GOTO 531
1460 PRINT SPC( 9);"NGR. PUSH -(TOS)
1461 GOTO 531
1470 PRINT SPC( 9);"LNOT. PUSH -(TOS) (1'S COMP)
1471 GOTO 531
1480 PRINT SPC( 9);"SRS.": GOTO 2560
1490 PRINT SPC( 9);"SBI. PUSH ((TOS-1) - (TOS))
1491 GOTO 531
1500 PRINT SPC( 9);"SBR. PUSH ((TOS-1) - (TOS))
1501 GOTO 531
1510 PRINT SPC( 9);"SGS.": GOTO 2560
1520 PRINT SPC( 9);"SQI. PUSH ((TOS)**2)
1521 GOTO 531
1530 PRINT SPC( 9);"SQR. PUSH ((TOS)**2)
1531 GOTO 531
1540 PRINT " STO. (TOS-1)^ := (TOS)
1541 GOTO 531
1550 PRINT SPC( 9);"IXS. PUSH #((TOS-1)^.(TOS)) --INDEX STRING ARRAY"
1551 GOTO 531
1560 PRINT SPC( 9);"UNI. UNION OF SETS (TOS) OR (TOS-1)": GOTO 531
1570 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" ";
1571 B1 = P8 + 2: GOSUB 1100: PRINT "LDE. PUSH DATASEG(";
1572 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);").";
1573 B1 = P8 + 2: GOSUB 1100: PRINT
1575 IF PEEK (P8 + 2) > 127 THEN 534
1576 GOTO 533
1580 REM MANY SUB FUNCTIONS TO THIS ONE
1581 GOTO 3000: REM 158
1590 PRINT SPC( 9);"LDCN. PUSH #0000"
1591 GOTO 531
1600 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2); SPC( 7);"ADJ. ";"ADJ SET TO "; RIGHT$ (A$,2);" WORDS"
1601 GOTO 532
1610 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2); SPC( 7);"UJP. IF NOT (TOS) THEN JUMP TO ";
1611 A = PEEK (P8 + 1): IF A < 128 THEN A = P8 + A + 2: GOTO 1615
1612 X = P5 + 8 - 256 + A
1613 A = X - PEEK (X) - PEEK (X + 1) * 256
1615 A = A + PA: GOSUB 550: PRINT A$
1616 GOTO 532
1620 B1 = P8 + 1: GOSUB 1100: PRINT " INC. PUSH #(TOS)^.(";
1621 B1 = P8 + 1: GOSUB 1120: PRINT ")"
1622 IF PEEK (P8 + 1) > 127 THEN 533
1623 GOTO 532
1630 B1 = P8 + 1: GOSUB 1100: PRINT " IND. PUSH (TOS)^.";:B1 = P8 + 1: GOSUB 1120: PRINT
1632 IF PEEK (P8 + 1) > 127 THEN GOTO 533
1633 GOTO 532
1640 B1 = P8 + 1: GOSUB 1100: PRINT " IXA. PUSH #((TOS-1)[TOS]). ARRAY SIZE=";
1641 B1 = P8 + 1: GOSUB 1120: PRINT
1642 IF PEEK (P8 + 1) > 127 THEN 533
1643 GOTO 532
1650 B1 = P8 + 1: GOSUB 1100: REM PRINT "B"IG WORD
1651 PRINT " LA0. PUSH #BASE.";:B1 = P8 + 1: GOSUB 1120: PRINT
1652 IF PEEK (P8 + 1) > 127 THEN 533
1653 GOTO 532
1660 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" ";: IF PEEK (P8 + 1) < = 0 THEN 1662
1661 FOR X = 1 TO PEEK (P8 + 1):A = PEEK (P8 + 1 + X): GOSUB 550: PRINT RIGHT$ (A$,2);" ";: NEXT X
1662 PRINT : FOR X = 1 TO PEEK (P8 + 1): PRINT CHR$ ( PEEK (P8 + 1 + X));: NEXT
1663 PRINT : PRINT SPC( 17);"LSA. PUSH #(PC+1) POINTER TO THE STRING"
1664 P8 = P8 + PEEK (P8 + 1) + 2: GOTO 500
1670 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" ";
1671 B1 = P8 + 2: GOSUB 1100: PRINT "LAE. PUSH #DATASEG(";
1672 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);").";
1673 B1 = P8 + 2: GOSUB 1120: PRINT
1675 IF PEEK (P8 + 2) > 127 THEN 534
1676 GOTO 533
1680 B1 = P8 + 1: GOSUB 1100: PRINT " MOV. (TOS-1)^ := (TOS)^ BT ";
1681 B1 = P8 + 1: GOSUB 1120: PRINT " WORDS"
1683 IF PEEK (P8 + 1) > 127 THEN 533
1684 GOTO 532
1690 B1 = P8 + 1: GOSUB 1100: REM PRINT "B"IG WORD "XX XX " OR "XX " IN RAW FORMAT
1691 PRINT " LDO. PUSH BASE.";:B1 = P8 + 1: GOSUB 1120: PRINT : REM PRINT"B"IG WORD "XXXX" OR "XX"
1692 IF PEEK (P8 + 1) > 127 THEN 533
1693 GOTO 532
1700 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2); SPC( 7);"SAS. TOS=CHAR::(TOS-1)^ := TOS CHAR"
1701 PRINT SPC( 17);" TOS=PTR ::(TOS-1)^ := (TOS)^ "; RIGHT$ (A$,2);" CHARACTERS MAX
1702 GOTO 532
1710 B1 = P8 + 1: GOSUB 1100: REM PRINT "B"IG WORD
1711 PRINT " SRO. BASE.";:B1 = P8 + 1: GOSUB 1120: PRINT " := (TOS)
1712 IF PEEK (P8 + 1) > 127 THEN 533
1713 GOTO 532
1720 PZ = 0: IF P8 / 2 = INT (P8 / 2) THEN A = PEEK (P8 + 1): PRINT "(";: GOSUB 550: PRINT RIGHT$ (A$,2);")";:PZ = 1
1721 W1 = PEEK (P8 + PZ + 1) + PEEK (P8 + PZ + 2) * 256:W2 = PEEK (P8 + PZ + 3) + PEEK (P8 + PZ + 4) * 256:W3 = PEEK (P8 + PZ + 5) + PEEK (P8 + PZ + 6) * 256
1722 FOR X = 1 TO 6:A = PEEK (P8 + PZ + X): GOSUB 550: PRINT RIGHT$ (A$,2);" ";: NEXT X
1723 PRINT "TABLE: ";:PY = 2 * (W2 - W1 + 1): REM # OF BYTES
1724 FOR X = 1 TO PY:A = PEEK (P8 + PZ + 6 + X): GOSUB 550: PRINT RIGHT$ (A$,2);" ";: NEXT X
1725 PRINT : PRINT SPC( 17);"XJP. W1,W2,W3,<TABLE>"
1726 P8 = P8 + PZ + 6 + PY * (PY > 0) + 1: GOTO 500
1730 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" "; SPC( 6);
1731 PRINT "RNP. RETURN FROM NON-BASE PROCEDURE."
1732 GOTO 532
1740 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" "; SPC( 6);
1741 PRINT "CIP. CALL INTERMEDIATE PROCEDURE: ";: PRINT RIGHT$ (A$,2)
1742 GOTO 532
1750 REM EQU
1751 GOTO 2900
1760 REM GEQ
1761 GOTO 2900
1770 REM GRT
1771 GOTO 2900
1780 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" ";
1781 B1 = P8 + 2: GOSUB 1100: REM PRINT "B"IG WORD
1782 PRINT "LDA. PUSH #ACTREC(-";:A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);").";:B1 = P8 + 2: GOSUB 1120: PRINT
1783 IF PEEK (P8 + 2) > 127 THEN 534
1784 GOTO 533
1790 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" ";
1791 PZ = 0: IF (P8 + 1) / 2 = INT ((P8 + 1) / 2) THEN A = PEEK (P8 + 1): PRINT "(";: GOSUB 550: PRINT RIGHT$ (A$,2);")";:PZ = 1: REM THE WORD BLOCK IS WORD ALIGNED
1792 X = 2 * PEEK (P8 + 1): REM # BYTES IN BLOCK
1793 FOR Y = 1 TO X:A = PEEK (P8 + PZ + 2 + Y - 1): GOSUB 550: PRINT RIGHT$ (A$,2);" ";: NEXT Y
1794 PRINT : PRINT SPC( 17);"LDC. PUSH ";:A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" WORDS"
1795 P8 = P8 + PZ + 2 + 2 * PEEK (P8 + 1): GOTO 500
1800 REM LEQ
1801 GOTO 2900
1810 REM LES
1811 GOTO 2900
1820 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" ";
1821 B1 = P8 + 2: GOSUB 1100: REM PRINT "B"IG WORD
1822 PRINT "LOD. PUSH ACTREC(-";:A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);").";:B1 = P8 + 2: GOSUB 1120: PRINT
1823 IF PEEK (P8 + 2) > 127 THEN 534
1824 GOTO 533
1830 REM NEQ
1831 GOTO 2900
1840 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" ";
1841 B1 = P8 + 2: GOSUB 1100: REM PRINT "B"IG WORD
1842 PRINT "STR. ACTREC(-";:A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);").";:B1 = P8 + 2: GOSUB 1120: PRINT " := TOS"
1843 IF PEEK (P8 + 2) > 127 THEN 534
1844 GOTO 533
1850 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2); SPC( 7);"UJP. JUMP TO ";
1851 A = PEEK (P8 + 1): IF A < 128 THEN A = P8 + A + 2: GOTO 1855
1852 X = P5 + 8 - 256 + A
1853 A = X - PEEK (X) - PEEK (X + 1) * 256
1855 A = A + PA: GOSUB 550: PRINT A$
1856 GOTO 532
1860 PRINT SPC( 9);"LDP. PUSH FIELD. TOS: RTBIT;#;^"
1861 GOTO 531
1870 PRINT SPC( 9);"STP. (TOS-1)^FIELDPTR := TOS. (TOS)-1: RTBIT;#;^"
1871 GOTO 531
1880 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" LDM. PUSH "; RIGHT$ (A$,2);" WORDS USING (TOS)^"
1881 GOTO 532
1890 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" STM. (TOS-1)^ := (TOS)^ ";: PRINT RIGHT$ (A$,2);" WORDS"
1891 GOTO 532
1900 PRINT SPC( 9);"LDB. PUSH #00, PUSH (TOS-1)^.TOS BYTE"
1901 GOTO 531
1910 PRINT SPC( 9);"STB. (TOS-2)^.(TOS-1) := TOS BYTE"
1911 GOTO 531
1920 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" ";
1921 A = PEEK (P8 + 2): GOSUB 550: PRINT RIGHT$ (A$,2);" ";
1922 PRINT " IXP. INDEX PACKED ARRAY. USE TOS & TOS-1, UB1, UB2. ???"
1923 GOTO 533
1930 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" "; SPC( 6);
1931 PRINT "RBP. RETURN FROM BASE PROCEDURE."
1932 GOTO 532
1940 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" "; SPC( 6);
1941 PRINT "CBP. CALL BASE PROCEDURE: "; RIGHT$ (A$,2)
1942 GOTO 532
1950 PRINT SPC( 9);"EQUI. PUSH ((TOS-1) = (TOS))
1951 GOTO 531
1960 PRINT SPC( 9);"GEQI. PUSH ((TOS-1) >= (TOS))
1961 GOTO 531
1970 PRINT SPC( 9);"GRTI. PUSH ((TOS-1) > (TOS))
1971 GOTO 531
1980 REM
1981 B1 = P8 + 1: GOSUB 1100: REM PRINT "B"IG WORD
1984 PRINT " LLA. PUSH #MP.";:B1 = P8 + 1: GOSUB 1120: PRINT
1985 IF PEEK (P8 + 1) > 127 THEN GOTO 533
1986 GOTO 532
1990 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" ";
1991 A = PEEK (P8 + 2): GOSUB 550: PRINT RIGHT$ (A$,2);" ";
1992 PRINT " LDCI. PUSH #";
1993 A = PEEK (P8 + 2) * 256 + PEEK (P8 + 1): GOSUB 550: PRINT A$
1994 GOTO 533
2000 PRINT SPC( 9);"LEQI. PUSH ((TOS-1) <= (TOS))
2001 GOTO 531
2010 PRINT SPC( 9);"LESI. PUSH ((TOS-1) < (TOS))
2011 GOTO 531
2020 B1 = P8 + 1: GOSUB 1100: REM PRINT "B"IG
2022 PRINT " LDL. PUSH MP.";:B1 = P8 + 1: GOSUB 1120: PRINT
2025 IF PEEK (P8 + 1) > 127 THEN GOTO 533
2026 GOTO 532
2030 PRINT SPC( 9);"NEQI. PUSH ((TOS-1) <> (TOS))
2031 GOTO 531
2040 B1 = P8 + 1: GOSUB 1100: REM PRINT "B"IG
2041 PRINT " STL. MP.";:B1 = P8 + 1: GOSUB 1120: PRINT " := (TOS)"
2045 IF PEEK (P8 + 1) > 127 THEN GOTO 533
2046 GOTO 532
2050 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" ";:A = PEEK (P8 + 2): GOSUB 550: PRINT RIGHT$ (A$,2);" ";
2051 PRINT "CXP. CALL EXTERNAL PROCEDURE: "; RIGHT$ (A$,2);" IN SEGMENT: ";:A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2)
2052 GOTO 533
2060 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" "; SPC( 6);
2061 PRINT "CLP. CALL CHILD PROCEDURE: "; RIGHT$ (A$,2)
2062 GOTO 532
2070 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" "; SPC( 6);
2071 PRINT "CGP. CALL GLOBAL PROCEDURE: "; RIGHT$ (A$,2)
2072 GOTO 532
2080 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" ";
2081 FOR X = 1 TO PEEK (P8 + 1):A = PEEK (P8 + 1 + X): GOSUB 550: PRINT RIGHT$ (A$,2);" ";: NEXT X
2082 PRINT : PRINT SPC( 17);"LPA. PUSH #(PC+2) POINTER TO THE ARRAY"
2083 P8 = P8 + PEEK (P8 + 1) + 2: GOTO 500
2090 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" ";
2091 B1 = P8 + 2: GOSUB 1100: PRINT "STE. DATASEG(";
2092 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);").";
2093 B1 = P8 + 2: GOSUB 1120: PRINT " := (TOS)
2095 IF PEEK (P8 + 2) > 127 THEN 534
2096 GOTO 533
2100 PRINT SPC( 9);"???.": GOTO 2560
2110 PRINT SPC( 9);"EFJ.": GOTO 2560
2120 PRINT SPC( 9);"NFJ.": GOTO 2560
2130 B1 = P8 + 1: GOSUB 1100: PRINT "BPT. BREAKPOINT"
2131 IF PEEK (P8 + 1) > 127 THEN 533
2132 GOTO 532
2140 PRINT SPC( 9);"XIT. EXIT OPERATING SYSTEM."
2141 GOTO 531
2150 PRINT SPC( 9);"NOP. NOP"
2151 GOTO 531
2160 X = 1
2161 GOTO 2311
2170 X = 2
2171 GOTO 2311
2180 X = 3
2181 GOTO 2311
2190 X = 4
2191 GOTO 2311
2200 X = 5
2201 GOTO 2311
2210 X = 6
2211 GOTO 2311
2220 X = 7
2221 GOTO 2311
2230 X = 8
2231 GOTO 2311
2240 X = 9
2241 GOTO 2311
2250 X = 10
2251 GOTO 2311
2260 X = 11
2261 GOTO 2311
2270 X = 12
2271 GOTO 2311
2280 X = 13
2281 GOTO 2311
2290 X = 14
2291 GOTO 2311
2300 X = 15
2301 GOTO 2311
2310 X = 16
2311 PRINT SPC( 9);"SLDL.";:A = X: GOSUB 550: PRINT " PUSH MP."; RIGHT$ (A$,2)
2312 GOTO 531
2320 REM
2473 PRINT SPC( 9);"SLDO. PUSH BASE.";:A = P9 - 231: GOSUB 550: PRINT RIGHT$ (A$,2)
2475 GOTO 531
2480 REM
2550 X = P9 - 248
2552 PRINT SPC( 9);"SIND. PUSH (TOS)^.";X
2553 GOTO 531
2560 PRINT "NOT IMPLEMENTED.": GOTO 1531
2900 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);: GOSUB 2930
2901 IF P9 = 175 THEN PRINT "EQU. PUSH ((TOS-1) = (TOS))";
2902 IF P9 = 183 THEN PRINT "NEQ. PUSH ((TOS-1) <> (TOS))";
2903 IF P9 = 180 THEN PRINT "LEQ. PUSH ((TOS-1) <= (TOS))";
2904 IF P9 = 181 THEN PRINT "LES. PUSH ((TOS-1) < (TOS))";
2905 IF P9 = 176 THEN PRINT "GEQ. PUSH ((TOS-1) >= (TOS))";
2906 IF P9 = 177 THEN PRINT "GRT. PUSH ((TOS-1) > (TOS))";
2910 A = PEEK (P8 + 1)
2911 IF A = 2 THEN PRINT "--REALS"
2912 IF A = 4 THEN PRINT "--STRINGS"
2913 IF A = 6 THEN PRINT "--BOOLEANS"
2914 IF A = 8 THEN PRINT "--SETS"
2915 IF A = 10 THEN PRINT "--BYTE ARRAYS"
2916 IF A = 12 THEN PRINT "--WORDS"
2918 IF A = 10 OR A = 12 THEN 1575
2920 GOTO 532
2930 A = PEEK (P8 + 1)
2932 IF A = 10 OR A = 12 THEN 2935
2934 PRINT SPC( 7);: RETURN
2935 PRINT " ";:B1 = P8 + 2: GOSUB 1100
2937 RETURN
3000 REM 158
3002 A = PEEK (P8 + 1): GOSUB 550: PRINT RIGHT$ (A$,2);" "; SPC( 6);
3004 X = PEEK (P8 + 1): IF X < > 1 THEN 3010
3005 PRINT "NEW. (TOS) HAS # WORDS, (TOS-1)^ IS THE VARIABLE
3006 GOTO 532
3010 IF X < > 32 THEN 3020
3011 PRINT "MRK. MARK HEAP. (TOS)^ := NP"
3012 GOTO 532
3020 IF X < > 33 THEN 3030
3021 PRINT "RLS. RELEASE HEAP. NP := (TOS)^"
3022 GOTO 532
3030 IF X < > 22 THEN 3040
3031 PRINT "DUSE. DEC USE CNT FOR SEG #(TOS)
3032 GOTO 532
3040 IF X < > 23 THEN 3050
3041 PRINT "RND. PUSH ROUND(TOS)
3042 GOTO 532
3050 IF X < > 35 THEN 3060
3051 PRINT "POT. POWER OF TEN. PUSH 10^(TOS)
3052 GOTO 532
3060 IF X < > 4 THEN 3070
3061 PRINT "EXIT. EXIT FROM PROCEDURE. (TOS)=PROC# (TOS-1)=SEG#
3062 GOTO 532
3070 IF X < > 10 THEN 3080
3071 PRINT "FLC. FILLCHAR (DST+IDX,LEN,CHR)"
3072 GOTO 532
3080 IF X < > 11 THEN 3090
3081 PRINT "SCAN. SCAN???"
3082 GOTO 532
3090 IF X < > 02 THEN 3100
3091 PRINT "MVL. MOVELEFT"
3092 GOTO 532
3100 IF X < > 3 THEN 3110
3101 PRINT "MVR. MOVERIGHT"
3102 GOTO 532
3110 IF X < > 9 THEN 3130
3111 PRINT "TIM. TIME."
3112 GOTO 532
3120 PRINT "AN UNKNOWN STANDARD PROCEDURE ?!?!"
3121 GOTO 532
3130 IF X < > 5 THEN 3140
3131 PRINT "READ FROM VOL#"
3132 GOTO 532
3140 IF X < > 21 THEN 3150
3141 PRINT "RSEG. READ SEGMENT #(TOS) FROM ACTIVE SEG TABLE"
3142 GOTO 532
3150 IF X < > 38 THEN 3160
3151 PRINT "CHECK VOL#"
3152 GOTO 532
3160 IF X < > 6 THEN 3170
3161 PRINT "WRITE VOL#"
3162 GOTO 532
3170 IF X < > 34 THEN 3120
3171 PRINT "PUSH I/O ERROR STATUS"
3172 GOTO 532
5000 GOSUB 5: REM SET UP RWTS
5005 GOSUB 100: REM READ DIR
5010 GOSUB 140: REM DISP FNAMES
5015 GOSUB 200: REM GET FILE #
5017 IF FF = - 1 THEN END
5020 GOSUB 210: REM USE FILE#
5025 GOSUB 280: REM GET SEG#
5026 IF SS = - 1 THEN 5010
5030 GOSUB 285
5031 IF LL = 0 THEN 5025
5032 PA = 0
5035 GOSUB 375: REM GET $4000
5037 GOSUB 390
5040 GOSUB 420: REM GET PROC#
5042 IF P3 = - 1 THEN 5020
5045 GOSUB 440
5047 REM GOSUB 480
5048 GOTO 5040
5090 REM ----------
5100 GOSUB 5
5105 GOSUB 100
5110 GOSUB 140
5115 FOR FF = 1 TO FQ(1)
5120 GOSUB 210
5122 IF FQ(4) = - 1 THEN 5154
5125 FOR SS = 0 TO FQ(2)
5130 GOSUB 285
5131 IF LL = 0 THEN 5152
5132 PA = 0
5134 GOSUB 390
5140 FOR P3 = 1 TO FQ(3)
5142 PRINT : PRINT "FILE: ";FF;" SEG: ";SS;" PROC: ";P3
5145 GOSUB 440
5150 NEXT P3
5152 NEXT SS
5154 NEXT FF
5160 END
]
Tommy