jschultzpedersen Posted April 5 Share Posted April 5 I am just curious... There is an appearently undocumented feature in Extended Basic (called PERMANENT), that can be used used with subroutines. But what exactly does it do? It is in some ways similar to give a parameter by reference, as is described in the Extended basic manual. But to me it looks more like an explicit declaration of a local variable inside a sub. First, the known use of value by reference...(x), which in the example produces the results 5,6,5. The global variable x is unaffected by changes to its namesake inside the sub. 10 X=5 20 CALL TEST((X)) 30 PRINT X 100 SUB TEST(X) 110 PRINT X 120 X=X+1 130 PRINT X 140 SUBEND Then we have a sub with the PERMANENT specification for a variable (PERMANENT x). The result is 0,1,5. This is a bit strange, since the parameter in the sub header is ignored, and the variable x inside the sub behaves like it was not mentioned as a parameter. This is standard behaviour for local variables not mentioned in the header anyway. 10 X=5 20 CALL TEST(X) 30 PRINT X 100 SUB TEST(PERMANENT X) 110 PRINT X 120 X=X+1 130 PRINT X 140 SUBEND Finally we have the directly addressed variable, where changes inside the sub is done on the actual global variable. The result is 5,6,6. 10 X=5 20 CALL TEST(X) 30 PRINT X 100 SUB TEST(X) 110 PRINT X 120 X=X+1 130 PRINT X 140 SUBEND I suppose the PERMANENT specification is a leftover from some early version of Extended Basic. As far as I can see it is pointless to declare an explicit local variable, since variables inside the sub, that are not part of the sub header, are local anyway. But is there some hidden meaning? 2 Quote Link to comment Share on other sites More sharing options...
+bent_pin Posted April 5 Share Posted April 5 Run it on an emulator and see where the value is stored in memory. Might provide some insight. Quote Link to comment Share on other sites More sharing options...
HOME AUTOMATION Posted April 5 Share Posted April 5 Never heard of using in a SUB ...but than I'm not XB, man. Only familiar with the FILE SPEC.... ⬆️⬆️⬆️(LINK) to USER REF.⬆️⬆️⬆️ 1 1 Quote Link to comment Share on other sites More sharing options...
Gary from OPA Posted April 5 Share Posted April 5 This is leftover from TI Basic in fact. Token >FB But like @HOME AUTOMATION pointed out, it's for the type of file storage. Not sure what would happen if you use it someplace else. 1 Quote Link to comment Share on other sites More sharing options...
jschultzpedersen Posted April 5 Author Share Posted April 5 It is a weird command. I only noticed it while I was doing an article for the TI*MES magazine in UK on 'using code to generate code' - you know - using basic code to generate merge files with valid basic statements. I printed out the meaning of all tokens, and there it was! On another point. That of using subs. As far as I can measure, it does matter how many variable names you have in a program. The earliest variables defined seems to execute slightly faster that variables defined later. I think subs have their own local list of variables. So such variables execute faster within the subs context because the list is shorter. If so, this is one good reason to use subs. Forgive me if I am wrong on this. It is just my impression. But i like using subs for more complicated code sections because of its local variables. Besides, it adds structure to the code, and the overhead is small compared to using GOSUB-RETURN. If anyone is interested in an example of this 'code that makes code', you can get a list of all the tokens in Extended Basic with this program from my article in TI*MES, vol2. No.16. Summer Issue - June 2021. 100 OPEN #1:"DSK2.TOKENS",VARIABLE 163,DISPLAY ,OUTPUT 110 FOR N=129 TO 254 120 PRINT #1:CHR$(0)&CHR$(N); 130 PRINT #1:CHR$(N); 140 PRINT #1:CHR$(0) 150 NEXT N 160 PRINT #1:CHR$(255)&CHR$(255) 170 CLOSE #1 The code creates a merge format basic file. You can merge this file after a NEW command and use LIST "CLIP" to send the contents to a text file in Windows with Classic99 to read it. It can not be executed. Some of the token values represent internal directives like (QOUTED STRING FOLLOWS) that are used to interpret how the following string is to be interpreted. These will look like garbage in the text listing. 1 Quote Link to comment Share on other sites More sharing options...
apersson850 Posted April 5 Share Posted April 5 I've never used PERMANENT with any SUB in Extended BASIC. I've used a lot of SUBs, though. The different handling in CALL SUBROUTINE(X) and CALL SUBROUTINE((X)) is due to that in the latter, Extended BASIC interprets the argument as an expression, not a variable. Since you can't redefine an expression from inside a SUB, the effect is a value parameter instead of a reference one. In Pascal you would use procedure subroutine(var x: integer); as an alternative to procedure subroutine(x: integer); A big difference is that local variables in procedures in Pascal aren't static. They are forgotten as soon as you exit the procedure and thus don't keep their value for the next call. This is also why you can call a procedure recursively in Pascal, but you can't do that with a SUB in Extended BASIC. 1 Quote Link to comment Share on other sites More sharing options...
+Vorticon Posted April 5 Share Posted April 5 2 hours ago, jschultzpedersen said: But i like using subs for more complicated code sections because of its local variables. Besides, it adds structure to the code, and the overhead is small compared to using GOSUB-RETURN. I rarely use GOSUB. Using SUB instead allows for clearer and modular code that is easier to maintain. Quote Link to comment Share on other sites More sharing options...
apersson850 Posted April 5 Share Posted April 5 I agree. It's mainly if you need access to larger global data areas from the subroutine that the GOSUB-RETURN construct is the one you have to use. Quote Link to comment Share on other sites More sharing options...
+OLD CS1 Posted April 5 Share Posted April 5 "PERMANENT" shows up exactly one time in the Extended BASIC manual, and that is as a reserved word. It does not show up in the context of CALL SUB. It could be a bug in the XB parser which does allow the keyword to be placed within the SUB parameters, even without a code-generating utility. It accepts it when entering, it accepts it when executing, but you can do nothing with what it creates. With all XB's stack in VDP RAM, I can see the SUB definition and variables more easily. What I see is the parameter X is prefixed with the token >FB (as mentioned above by @Gary from OPA) I suspect this errant line creates a variable named >FB >58. To test, I entered this line: 1000 SUB EFFORT(PERMANENT X,Y,PERMANENT Z) Which created this (truncated) entry in VDP RAM: >45 >46 >46 >4F >52 >54 E F F O R T >B7 >FB >58 >B3 >59 >B3 >FB >5A >B6 ( _ X , Y , _ Z ) In this example, the SUB's name is EFFORT. The "(", ",", and ")" are tokenized, and the "_" is they keyword PERMANENT tokenized. So, what I conclude is this definition creates three local variables: _X, Y, and _Z, with "_" representing the byte >FB. Which means that variable cannot be touched by XB unless you use some hackery. Which I did. I took this program: 10 CALL EFFORT(2) 999 STOP 1000 SUB EFFORT(PERMANENT X) 1010 PRINT _X 1020 SUBEND Then changed the "_" in VDP RAM to token >FB, giving this: 10 CALL EFFORT(2) 999 STOP 1000 SUB EFFORT(PERMANENT X) 1010 PRINT PERMANENT X 1020 SUBEND Cool, huh? Yup... up until I ran it: 2 Quote Link to comment Share on other sites More sharing options...
Gary from OPA Posted April 5 Share Posted April 5 If you want to see where Permanent comes from originally you need to look at early /4 manuals and early ti basic manuals. It all to do with file storage, I think leftover from the minimal basic they Texas Instruments used as base for their own basic and the 990 system were you could have temporary files that disappeared after the program was closed. On the ti99 file storage system everything is listed as permanent so the flag in the open statement where it was originally designed to be used doesn't do anything. 3 Quote Link to comment Share on other sites More sharing options...
jschultzpedersen Posted April 5 Author Share Posted April 5 As the screen dump shows, you cannot say something like PRINT PERMANENT x. The only place I have found it to be acceptable to the Extended Basic interpreter is within the parameter list of a sub. An enhanced basic like RXB2024B does not accept it. Anyway, as it is totally pointless in practical use, I will conclude this by saying thanks to all for their input. 2 Quote Link to comment Share on other sites More sharing options...
SteveB Posted April 5 Share Posted April 5 12 hours ago, jschultzpedersen said: 100 SUB TEST(PERMANENT X) You BASICally found a parsing bug for the SUB statement. It ignores a single token in the variable list before any variable. Therefore the following also works: SUB TEST(SIZE X) SUB TEST(FIXED X) SUB TEST(DELETE X) If you CALL TEST(5), X will be ZERO ... I assume the 5 gets assigned to the strange token-named variable, which you can't access later on with print or anything else. When you set a comma after the token, you get an "incorrect argument list" at runtime. If you adjust your CALL for two arguments, it gets through and the second value gets assigned to X. Yet you can't access the Token-Variable with the first value, without provoking a syntax error. I tried to use it in PRINT, CALL and LET. This also works for more than one variable: SUB TEST(DELETE X, FIXED Y) Perhaps @RXB can share some insights of the SUB GPL code for this unexpected behaviour. Steve 4 Quote Link to comment Share on other sites More sharing options...
+InsaneMultitasker Posted April 5 Share Posted April 5 6 hours ago, Gary from OPA said: It all to do with file storage, I think leftover from the minimal basic they Texas Instruments used as base for their own basic and the 990 system were you could have temporary files that disappeared after the program was closed. File IO is where I recalled seeing it mentioned. For example, it is noted in the disk peripheral doc: 1 1 Quote Link to comment Share on other sites More sharing options...
+FarmerPotato Posted April 6 Share Posted April 6 Wow. Interesting bug testing, @OLD CS1 Here is "File Control Statements" from Specification for Texas Instruments Standard Basic, pp. 55-59. That is the "Green Book" from the C.B. Wilson documents (see documentation thread.) It's a really interesting book. You can find the definitions for PERMANENT / TEMPORARY and KEYED. And the SCRATCH command. It also shows CLOSE #1:DELETE. From Chapter 1, I infer that our BASICs were of the EN subsets. EN = Education Nucleus with supersets E1, R2 IN = Industrial Nucleus. No string variables! BN = Business Nucleus. Keyed-Indexed files are required in BN2. TI-BASIC File Specification.pdf Originally posted in this thread: 2 Quote Link to comment Share on other sites More sharing options...
RXB Posted April 6 Share Posted April 6 20 hours ago, SteveB said: You BASICally found a parsing bug for the SUB statement. It ignores a single token in the variable list before any variable. Therefore the following also works: SUB TEST(SIZE X) SUB TEST(FIXED X) SUB TEST(DELETE X) If you CALL TEST(5), X will be ZERO ... I assume the 5 gets assigned to the strange token-named variable, which you can't access later on with print or anything else. When you set a comma after the token, you get an "incorrect argument list" at runtime. If you adjust your CALL for two arguments, it gets through and the second value gets assigned to X. Yet you can't access the Token-Variable with the first value, without provoking a syntax error. I tried to use it in PRINT, CALL and LET. This also works for more than one variable: SUB TEST(DELETE X, FIXED Y) Perhaps @RXB can share some insights of the SUB GPL code for this unexpected behaviour. Steve Permanent token is 00FB PERMAZ EQU >FB PERMANENT [0496] *********************************************************** [0497] * OPEN STATEMENT HANDLER [0498] * Handle the BASIC OPNE statement. A legal syntax can only [0499] * be something like [0500] * OPEN #{exp}:{string-exp}[,{open-options}] [0501] * in which {open-option} is any of the following [0502] * DISPLAY, INPUT, VARIABLE, RELATIVE, INTERNAL, SEQUENTIAL, [0503] * OUTPUT, UPDATE, APPEND, FIXED or PERMANENT [0504] * [0505] * Each keyword can only be used once, which is being checke [0506] * with an OPTFLG-bit. For each specific option please refer [0507] * to the related routine. [0508] * Scanning stops as soon as no next field starting with a [0509] * comma can be found. [0510] * NOTE: After the actual DSR OPEN has been preformed, the [0511] * length of the record, whether VARIABLE or FIXED, [0512] * has to be non-zero. A zero length will cause an [0513] * INCORRECT STATEMENT error. 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0009 FLMGR-359 [0514] *********************************************************** [0515] 8032 06,93,58 OPEN CALL CHKFN See if we specified any file [0516] 8035 77,DA BS ERRFE Definitely not... no # or #0 [0517] 8037 06,93,74 CALL CHKCON Check and search given filenu [0518] 803A 77,DA BS ERRFE *** FILE NUMBER EXISTS *** [0519] * ERROR IF NOT STOPPED ON COLON [0520] 803C 0F,7E XML SPEED Must be at a [0521] 803E 00 BYTE SYNCHK * colon or else [0522] 803F B5 BYTE COLONZ * its an error [0523] 8040 06,96,5D CALL PARFN Parse filename and create PAB [0524] 8043 93,2C DDEC @PGMPTR Backup pgm pointer for next t [0525] 8045 0F,79 OPTION XML PGMCHR Get next program character [0526] * Next field should start with a comma [0527] 8047 D6,42,B3 OPTIZ0 CEQ COMMAZ,@CHAT [0528] 804A 41,0D BR CHECK [0529] * Enter HERE after comma exit in "SEQUENTIAL" [0530] 804C 0F,79 OPTIZ1 XML PGMCHR Next token please... [0531] * Treat DISPLAY and INPUT as special cases [0532] 804E D6,42,A2 CEQ DISPLZ,@CHAT [0533] 8051 60,EA BS OPTZ6 [0534] 8053 D6,42,92 CEQ INPUTZ,@CHAT [0535] 8056 60,F4 BS OPTZ7 [0536] 8058 A6,42,F3 SUB VARIAZ,@CHAT Reduce keyword offset to 0 [0537] 805B CA,42,09 CHE 9,@CHAT Keyword to high [0538] 805E 61,06 BS OPERR [0539] 8060 8A,42 CASE @CHAT JUST IN CASE [0540] 8062 40,BE BR OPTZ01 Option VARIABLE [0541] 8064 40,7C BR OPTZ02 RELATIVE [0542] 8066 40,E5 BR OPTZ03 INTERNAL [0543] 8068 40,81 BR OPTZ1 SEQUENTIAL [0544] 806A 40,A8 BR OPTZ2 OUTPUT [0545] 806C 40,AD BR OPTZ3 UPDATE [0546] 806E 40,B7 BR OPTZ4 APPEND [0547] 8070 40,C3 BR OPTZ5 FIXED [0548] * BR OPTZ0 PERMANENT <<<<<< [0549] * CASE 0 - "PERMANENT" ************************************ [0550] * Only check for multiple usage. Since PERMANENT is the [0551] * default, we might as well ignore it... [0552] 8072 DA,17,04 OPTZ0 CLOG >04,@OPTFLG [0553] 8075 41,06 BR OPERR [0554] 8077 B6,17,04 OR >04,@OPTFLG Not used ... use now [0555] 807A 40,45 BR OPTION Treat as simple default [0556] * CASE 2 - "RELATIVE" ************************************* [0557] * Select relative record file in PAB and fall through in [0558] * SEQUENTIAL code for multiple usage check. Also handle [0559] * initial file-size there. [0560] 807C B6,E0,05 OPTZ02 OR >01,V@FLG(@PABPTR) Indicate RELATIVE RECORD 807F 04,01 [0561] * CASE 4 - "SEQUENTIAL" *********************************** [0562] * Checks for multiple usage. Remainder of syntax demads th [0563] * we have something like: [0564] * [{numeric expression}],... [0565] * In case only a comma is found, we use the default. [0566] * Everything else has to be evaluated as a numeric [0567] * expression, convertable to a 16-bit integer value. [0568] 8081 DA,17,08 OPTZ1 CLOG >08,@OPTFLG [0569] 8084 41,06 BR OPERR [0570] 8086 B6,17,08 OR >08,@OPTFLG First time usage, ok [0571] 8089 0F,79 XML PGMCHR Check next token for default [0572] * Comma means default has been used [0573] 808B D6,42,B3 CEQ COMMAZ,@CHAT [0574] 808E 60,4C BS OPTIZ1 [0575] 8090 06,95,B0 CALL CHKEND Check for end of statement [0576] 8093 61,0D BS CHECK 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0010 FLMGR-359 [0577] 8095 06,80,9F CALL CHKPAR Preform combined checking & p [0578] 8098 BD,E0,0A DST @FAC,V@RNM(@PABPTR) Non-zero result 809B 04,4A [0579] 809D 40,47 BR OPTIZ0 Scan other options [0580] * Parse and check a numeric argument in here.... [0581] 809F 0F,74 CHKPAR XML PARSE If not ... parse up to comma [0582] 80A1 B3 BYTE COMMAZ [0583] 80A2 06,93,5F CALL CHKCNV Check and convert to integer [0584] 80A5 61,06 BS OPERR Oops..., someone made a mista [0585] 80A7 00 RTN Return to caller [0586] * CASE 5 - "OUTPUT" *************************************** [0587] * Select mode code "01" and check for multiple usage. Use [0588] * MFLAG bit in OPTFLG for checking. [0589] 80A8 B6,E0,05 OPTZ2 OR >02,V@FLG(@PABPTR) Mode code = 01 80AB 04,02 [0590] * CASE 6 - "UPDATE" *************************************** [0591] * Default ... Check for multiple usage only... [0592] * Test for previous usage of any mode setting [0593] 80AD DA,17,01 OPTZ3 CLOG >01,@OPTFLG [0594] 80B0 41,06 BR OPERR [0595] 80B2 B6,17,01 OR >01,@OPTFLG If not... set "MODE USED" bit [0596] 80B5 40,45 BR OPTION Continue option scan [0597] * CASE 7 - "APPEND" *************************************** [0598] * Mode code "11" indicates APPEND mode. [0599] 80B7 B6,E0,05 OPTZ4 OR >06,V@FLG(@PABPTR) Mode code = 11 80BA 04,06 [0600] 80BC 40,AD BR OPTZ3 [0601] * CASE 1 - "VARIABLE" ************************************* [0602] * Change record type to VARIABLE and continue as FIXED [0603] 80BE B6,E0,05 OPTZ01 OR >10,V@FLG(@PABPTR) Indicate variable length mo 80C1 04,10 [0604] [0605] * CASE 8 - "FIXED" **************************************** [0606] * Fixed is default. Don't change anything, unless argument [0607] * is given. In this case evaluate as numeric expression an [0608] * check for 8-bit integer range... [0609] * This routine is also used for VARIABLE !!!!! [0610] 80C3 0F,79 OPTZ5 XML PGMCHR Get next character [0611] 80C5 D6,42,B3 CEQ COMMAZ,@CHAT Could be some argument [0612] 80C8 60,DB BS OPTZ55 [0613] 80CA 06,95,B0 CALL CHKEND Could also be end of statemen [0614] 80CD 60,DB BS OPTZ55 It is an EOS [0615] 80CF 06,80,9F CALL CHKPAR Check & parse expression [0616] * Check for byte overflow (records can only be up to 255 [0617] * bytes in length) [0618] 80D2 8E,4A CZ @FAC [0619] 80D4 41,06 BR OPERR [0620] 80D6 BC,E0,08 ST @FAC1,V@LEN(@PABPTR) Select non-zero rec-size 80D9 04,4B [0621] 80DB DA,17,10 OPTZ55 CLOG >10,@OPTFLG [0622] 80DE 41,06 BR OPERR [0623] 80E0 B6,17,10 OR >10,@OPTFLG Prevent to much usage of mode [0624] 80E3 40,47 BR OPTIZ0 Continue option scan [0625] * CASE 3 - "INTERNAL" ************************************* [0626] * Select INTERANL file type and continue in DIPLAY [0627] 80E5 B6,E0,05 OPTZ03 OR 8,V@FLG(@PABPTR) Select INTERNAL type 80E8 04,08 [0628] * CASE 9 - "DISPLAY" ************************************** [0629] * Default. Only check for multiple usage of either DISPLAY [0630] * or INTERNAL... [0631] 80EA DA,17,02 OPTZ6 CLOG >02,@OPTFLG [0632] 80ED 41,06 BR OPERR [0633] 80EF B6,17,02 OR >02,@OPTFLG Else set "DISPLAY/INTERAL" fl [0634] 80F2 40,45 BR OPTION Continue... DISPLAY is defaul 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0011 FLMGR-359 [0635] * CASE 10 "INPUT" ***************************************** [0636] * Same as any other I/O type definition. Mode code "10" .. [0637] * Continue in OPTZ3 [0638] 80F4 B6,E0,05 OPTZ7 OR >04,V@FLG(@PABPTR) Mode code = 10 80F7 04,04 [0639] 80F9 40,AD BR OPTZ3 [0640] * CLRFRE deallocates previously alocated (parts of) PAB's a [0641] * return with an error message [0642] 80FB 86,02 CLRFRE CLR @MNUM Undo any allocation [0643] 80FD BC,03,E0 ST V@OFS(@PABPTR),@MNUM+1 We need the length for 8100 03,04 [0644] * that [0645] * V@OFS(@PABPTR) Was set up in PARFN routine [0646] 8102 A1,40,02 DADD @MNUM,@FREPTR Update the first free world [0647] 8105 00 RTN And return [0648] 8106 06,80,FB OPERR CALL CLRFRE First undo the allocation [0649] 8109 06,6A,84 ERRSYN CALL ERRZZ Then give an error [0650] 810C 03 BYTE 3 * SYNTAX ERROR [0651] * Continue with CHECK to conplete the actual OPEN [0652] 810D 06,95,B0 CHECK CALL CHKEND Check EOS [0653] 8110 41,06 BR OPERR Not EOS : SYNTAX ERROR [0654] * If the user hasn't specified VARIABLE or FIXED, the [0655] * default specification depends on the file type. [0656] * Change current default (=VARIABLE) to FIXED for [0657] * RELATIVE files. [0658] 8112 DA,E0,05 CLOG >01,V@FLG(@PABPTR) RELATIVE RECORD 8115 04,01 [0659] 8117 61,27 BS G8127 [0660] 8119 DA,E0,05 CLOG >10,V@FLG(@PABPTR) VARIABLE RECORD 811C 04,10 [0661] 811E 61,25 BS G8125 [0662] 8120 06,80,FB FILZZ CALL CLRFRE Undo the PAB allocation [0663] 8123 57,DA BR ERRFE FILE ERROR [0664] 8125 41,31 G8125 BR G8131 Sequential file, check rec. m [0665] 8127 DA,17,10 G8127 CLOG >10,@OPTFLG No definition yet [0666] 812A 41,31 BR G8131 [0667] 812C B6,E0,05 OR >10,V@FLG(@PABPTR) Force VARIABLE mode 812F 04,10 [0668] 8131 06,97,6E G8131 CALL CDSR Call the DSR, return with err [0669] 8134 57,97 BR ERRZ2B indication in COND... [0670] 8136 87,E0,0A DCLR V@RNM(@PABPTR) Make sure we start with recor 8139 04 [0671] * Check for undefined record length. The record length for [0672] * any type might be defined by the DSR [0673] 813A 8E,E0,08 CZ V@LEN(@PABPTR) 813D 04 [0674] 813E 61,20 BS FILZZ [0675] 8140 BC,03,E0 ST V@LEN(@PABPTR),@MNUM+1 Get record length 8143 08,04 [0676] 8145 86,02 CLR @MNUM Create two byte result and [0677] 8147 86,E0,03 CLR V@OFS(@PABPTR) allocate - remove offset for 814A 04 [0678] * later use [0679] 814B BD,4A,02 DST @MNUM,@FAC - prepare for space claim [0680] * Check for special case : no PAB's yet [0681] 814E 8F,3C DCZ @IOSTRT [0682] 8150 41,57 BR G8157 [0683] 8152 BD,3C,04 DST @PABPTR,@IOSTRT Simply enter the first pointe [0684] 8155 41,69 BR G8169 [0685] 8157 BD,0A,3C G8157 DST @IOSTRT,@STADDR Search for the end of the cha [0686] 815A 8F,B0,0A G815A DCZ V*STADDR [0687] 815D 61,65 BS G8165 [0688] 815F BD,0A,B0 DST V*STADDR,@STADDR Keep on deferring 8162 0A 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0012 FLMGR-359 [0689] 8163 41,5A BR G815A [0690] 8165 BD,B0,0A G8165 DST @PABPTR,V*STADDR Update last chain link 8168 04 [0691] 8169 BD,E0,06 G8169 DST @PABPTR,V@BUF(@PABPTR) Set empty buffer first 816C 04,04 [0692] 816E 0F,72 XML MEMCHK Check memory overflow & strin [0693] 8170 77,CA BS ERRMEM * MEMORY FULL [0694] 8172 A5,40,02 DSUB @MNUM,@FREPTR Compute buffer entry address [0695] 8175 A5,E0,06 DSUB @MNUM,V@BUF(@PABPTR) Correct buffer address in 8178 04,02 [0696] 817A 0F,75 XML CONT Return to the parser [0697] *********************************************************** [0698] * DELETE ROUTINE [0699] * Use file # 0 for this operation. Parse the file name [0700] * string-expression as usual, and delete the PAB before [0701] * actually calling the DSR. [0702] *********************************************************** [0703] 817C 86,17 DELET CLR @FNUM Create file #0 - non-existing [0704] 817E 06,96,5D CALL PARFN Handle as normal PAB OPEN [0705] 8181 06,95,B0 CALL CHKEND Check EOS first [0706] 8184 41,06 BR OPERR Not EOS : go undo PAB allocat [0707] * and print SYNTAX ERROR [0708] 8186 86,02 CLR @MNUM * Delete PAB again before calling [0709] 8188 BC,03,E0 ST V@OFS(@PABPTR),@MNUM+1 Create double byte PAB 818B 03,04 [0710] [0711] 818D A1,40,02 DADD @MNUM,@FREPTR Update free word pointer [0712] 8190 06,97,61 CALL IOCALL Preform I/O call for actual d [0713] 8193 07 BYTE CZDELE [0714] 8194 0F,75 XML CONT [0715] *********************************************************** [0716] * CLOSE ROUTINE [0717] * Syntax could be [0718] * CLOSE #{ num exp } or CLOSE #{ num exp }:DELETE [0719] * [0720] * Possibly output pending records before closing or [0721] * deleting the file. [0722] *********************************************************** [0723] 8196 06,93,58 CLOSE CALL CHKFN Check for "no #" / "#0" cases [0724] 8199 77,DA BS ERRFE Not for "CLOSE" you don't [0725] 819B 06,93,74 CALL CHKCON Check file number etc... [0726] 819E 57,DA BR ERRFE *** FILE NUMBER NOT IN SYSTEM [0727] 81A0 06,93,93 CALL OUTEOF Output pending records [0728] 81A3 BE,E0,04 ST CZCLOS,V@COD(@PABPTR) Default to CLOSE I/O code 81A6 04,01 [0729] 81A8 D6,42,B5 CEQ COLONZ,@CHAT Check for ":DELETE" spec. [0730] 81AB 41,B8 BR G81B8 [0731] 81AD 0F,79 XML PGMCHR Request next input token [0732] 81AF 0F,7E XML SPEED Must be at a [0733] 81B1 00 BYTE SYNCHK * "DELETE" else [0734] 81B2 99 BYTE DELETZ * its an error [0735] 81B3 BE,E0,04 ST CZDELE,V@COD(@PABPTR) Change CLOSE to DELETE 81B6 04,07 [0736] 81B8 06,95,B0 G81B8 CALL CHKEND EOS? [0737] 81BB 41,09 BR ERRSYN NO:SYNTAX ERROR [0738] 81BD 06,97,6E CALL CDSR Call DSR with whatever we hav [0739] 81C0 41,C7 BR CLOSZ1 Reset means error.... [0740] 81C2 06,93,A9 CALL DELPAB Delete PAB and data-buffer [0741] 81C5 0F,75 XML CONT Return to parser routine [0742] 81C7 BD,5C,E0 CLOSZ1 DST V@4(@PABPTR),@ARG Save error code for message 81CA 04,04 [0743] 81CC 06,93,A9 CALL DELPAB Now delete the PAB [0744] 81CF BD,04,40 DST @FREPTR,@PABPTR Store error-code in free memo [0745] 81D2 A7,04,00 DSUB 6,@PABPTR Create standard size PAB 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0013 FLMGR-359 81D5 06 [0746] 81D6 BD,E0,04 DST @ARG,V@4(@PABPTR) Copy error-code 81D9 04,5C [0747] 81DB 57,BE BR ERRIO Exit to error-routine [0748] *********************************************************** [0749] * CLOSE ALL ROUTINE [0750] * CLOSE all the existing PABs ... ignore errors [0751] * [0752] * NOTE: "CLSLBL" is used in the I/O error routine to [0753] * determine if a warning should be given rather than [0754] * an error. [0755] *********************************************************** [0756] 81DD BD,04,B0 G81DD DST V*PABPTR,@PABPTR 81E0 04 [0757] 81E1 8F,B0,04 CLSAZ0 DCZ V*PABPTR Find last PAB in chain [0758] 81E4 41,DD BR G81DD [0759] 81E6 06,93,93 CALL OUTEOF Take care of pending records [0760] 81E9 BE,E0,04 CLSLBL ST CZCLOS,V@COD(@PABPTR) Select CLOSE code 81EC 04,01 [0761] 81EE 06,97,6E CALL CDSR CLOSE to DSR routine [0762] 81F1 06,93,A9 CALL DELPAB Delete PAB - ignore CLOSE err [0763] 81F4 BD,04,3C CLSALL DST @IOSTRT,@PABPTR Start at beginning of chain [0764] 81F7 8F,3C DCZ @IOSTRT Continue until done [0765] 81F9 41,E1 BR CLSAZ0 [0766] 81FB 00 RTN And return [0767] *********************************************************** [0768] * RESTORE ROUTINE [0769] * RESTORE can have any of four forms: [0770] * [0771] * RESTORE Restore to first DATA [0772] * RESTORE 20 Restore DATA pointer [0773] * RESTORE #1 Rewind file number 1 [0774] * RESTORE #1, REC 2 Position file 1 at record 2 [0775] *********************************************************** [0776] 81FC 87,4A RESTOR DCLR @FAC Assume simple RESTORE [0777] 81FE D6,42,FD CEQ NUMBEZ,@CHAT [0778] 8201 42,1F BR OLDCD [0779] 8203 06,93,58 CALL CHKFN Check for #<filenumber> [0780] 8206 8F,4A DCZ @FAC Found equivalent of #0 [0781] 8208 62,27 BS OLDCZ0 [0782] 820A 06,93,74 CALL CHKCON Check and decode file # [0783] 820D 57,DA BR ERRFE Give error if file not there [0784] 820F 06,93,93 CALL OUTEOF Output pending record [0785] 8212 87,E0,0A DCLR V@RNM(@PABPTR) Initialize to record 0 8215 04 [0786] 8216 06,94,C5 CALL PARREC Parse possible record clause [0787] 8219 06,97,61 CALL IOCALL Call DSR routine with [0788] 821C 04 BYTE CZREST * RESTORE I/O code [0789] 821D 0F,75 XML CONT Return if no error found [0790] * Following code is for handling RESTORE to line number [0791] * within program [0792] 821F 06,95,B0 OLDCD CALL CHKEND Check for start with end [0793] 8222 62,27 BS OLDCZ0 If we have anything else [0794] 8224 06,A0,06 CALL LINE in FAC (double) [0795] 8227 D5,30,32 OLDCZ0 DCEQ @ENLN,@STLN [0796] 822A 42,33 BR G8233 [0797] 822C 06,6A,82 WRNNPP CALL WARNZZ * NO PROGRAM PRESENT * [0798] 822F 1D BYTE 29 [0799] 8230 05,60,12 B TOPL15 Go back to toplevel [0800] 8233 BD,36,32 G8233 DST @ENLN,@LNBUF Start at beginning of program [0801] 8236 A7,36,00 DSUB 3,@LNBUF Backup for first line number 8239 03 [0802] * Check against given line number [0803] 823A 06,91,BF OLDCZ1 CALL GRSUB3 Read 2 bytes of line ptr from 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0014 FLMGR-359 [0804] * line # table which is in ERA [0805] 823D 36 BYTE LNBUF * Source address on ERAM/VDP [0806] * @EEE1: Destination addr on CP [0807] 823E C5,4A,58 DCH @EEE1,@FAC Try to get something higher [0808] 8241 42,4E BR G824E [0809] 8243 D5,36,30 DCEQ @STLN,@LNBUF Last line in program [0810] 8246 77,D6 BS ERRDAT [0811] 8248 A7,36,00 DSUB 4,@LNBUF Get next entry in line # tabl 824B 04 [0812] 824C 42,3A BR OLDCZ1 Try again with next line [0813] 824E A3,36,00 G824E DADD 3,@LNBUF Undo subtraction 8251 03 [0814] 8252 06,A0,08 CALL DATAST Setup pointer for READ [0815] 8255 0F,75 XML CONT Continue PARSE [0816] *********************************************************** [0817] * DISPLAY ROUTINE [0818] * DISPLAY handles all random screen access stuff.. [0819] * the AT-clause, and the BEEP, ERASE ALL and SIZE clause. [0820] *********************************************************** [0821] 8257 06,94,F2 DISPL1 CALL DISACC Evaluate DISPLAY options [0822] 825A 63,95 BS EOLEX EXIT directly on end-of-state [0823] * If anything is specified it has to be a colon [0824] 825C 8E,04 CZ @PABPTR Nothing was specified [0825] 825E 62,C4 BS PRINZ1 [0826] * At this point we MUST have a colon, or else we error off [0827] * (SYNTAX ERROR) [0828] 8260 0F,7E XML SPEED Check for a colon [0829] 8262 00 BYTE SYNCHK * and continue [0830] 8263 B5 BYTE COLONZ * it approved [0831] 8264 42,C4 BR PRINZ1 Continue with PRINT items [0832] *********************************************************** [0833] * PRINT ROUTINE [0834] * MAIN-HANDLER FOR ALL PRINT-FUNCTIONS [0835] *********************************************************** [0836] 8266 06,97,42 PRINT CALL INITKB Initialize keyboard I/O [0837] 8269 D6,42,FD CEQ NUMBEZ,@CHAT Could still be anything [0838] 826C 42,C4 BR PRINZ1 [0839] 826E 06,93,58 CALL CHKFN Check if default or open chan [0840] 8271 8F,4A DCZ @FAC Default intended [0841] 8273 62,A5 BS PRNZ10 [0842] 8275 06,93,74 CALL CHKCON Check and convert expression [0843] 8278 57,DA BR ERRFE Error if PAB not in system [0844] * PRINT allowed in output, append or update modes [0845] * Not allowed in input mode [0846] 827A DA,E0,05 CLOG >04,V@FLG(@PABPTR) 827D 04,04 [0847] 827F 62,88 BS G8288 [0848] 8281 DA,E0,05 CLOG >02,V@FLG(@PABPTR) 8284 04,02 [0849] 8286 77,DA BS ERRFE [0850] 8288 D6,E0,04 G8288 CEQ CZREAD,V@COD(@PABPTR) 828B 04,02 [0851] 828D 42,93 BR G8293 [0852] 828F 86,E0,03 CLR V@OFS(@PABPTR) Unpend pending INPUTs 8292 04 [0853] 8293 BE,E0,04 G8293 ST CZWRIT,V@COD(@PABPTR) uncomplete PRINTs 8296 04,03 [0854] 8298 06,96,F8 CALL PRINIT Initialize some variables [0855] * Next character has to be either EOL, COMMA, or COLON [0856] 829B 06,95,B0 CALL CHKEND [0857] 829E 63,95 BS EOLEX exit on end of statement [0858] 82A0 06,94,C5 CALL PARREC Parse possible record clause [0859] 82A3 62,B1 BS PRINZ0 found "," but no REC clause [0860] 82A5 06,95,B0 PRNZ10 CALL CHKEND 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0015 FLMGR-359 [0861] 82A8 63,95 BS EOLEX Exit on end of statement for [0862] * "PRINT #0" or "PRINT file position" [0863] 82AA D6,42,B3 CEQ COMMAZ,@CHAT [0864] 82AD 42,BE BR G82BE [0865] 82AF 0F,79 XML PGMCHR Get next in line [0866] 82B1 8E,04 PRINZ0 CZ @PABPTR For "PRINT #0" [0867] 82B3 63,CF BS USING [0868] * Interal type of file? [0869] 82B5 DA,E0,05 CLOG >08,V@FLG(@PABPTR) 82B8 04,08 [0870] 82BA 57,DA BR ERRFE [0871] 82BC 43,CF BR USING Execute USING clause [0872] 82BE 0F,7E G82BE XML SPEED Must be at a [0873] 82C0 00 BYTE SYNCHK * colon at this point [0874] 82C1 B5 BYTE COLONZ * and error off on others [0875] 82C2 42,C9 BR CONPRT Make it a short branched ELSE [0876] 82C4 D6,42,ED PRINZ1 CEQ USINGZ,@CHAT [0877] 82C7 63,CF BS USING End standard initialization [0878] * Test standard separators [0879] 82C9 06,96,2A CONPRT CALL TSTSEP Test separator character [0880] 82CC D6,42,FC CEQ TABZ,@CHAT Handle TABs [0881] 82CF 63,2D BS PRTAB [0882] * At this point we've checked TAB and ; , : [0883] * The only remaining print items have to be expressions [0884] * All expressions are being handled below. [0885] * If the result of the expression is a numeric, the string [0886] * is transformed into a string and printed. Strings are [0887] * printed "as is". [0888] * The code for strings and converted numerics cannot be ma [0889] * common, since numerics may require an extra space behind [0890] * the item, depending upon the current position in the reco [0891] * Either way, the string is chunked up into little pieces [0892] * it won't fit in an empty record. [0893] 82D1 0F,74 XML PARSE Evaluate the expression [0894] 82D3 B5 BYTE COLONZ [0895] * Special code for INTERNAL file handling [0896] * Translate numeric datums into string format and indicate [0897] * length 8. Then check to see if the item fits within the [0898] * current record. If not, it is an error, since each item [0899] * has to fit. [0900] 82D4 06,83,C5 CALL TSTINT Test for internal files [0901] 82D7 63,03 BS OTHEZ1 Nope, something different [0902] 82D9 D6,4C,65 CEQ STRVAL,@FAC2 Change numerics [0903] 82DC 62,EC BS G82EC [0904] 82DE BE,56,08 ST 8,@FAC12 To string length 8 [0905] 82E1 35,00,08 MOVE 8,@FAC,@ARG Save in ARG 82E4 5C,4A [0906] 82E6 BE,55,5C ST ARG,@FAC11 And use this as source [0907] 82E9 06,96,0E CALL RSTRING Reserve some string space [0908] 82EC BC,5C,07 G82EC ST @RECLEN,@ARG Compute remaining space to EO [0909] 82EF A4,5C,06 SUB @CCPPTR,@ARG for space checking [0910] 82F2 90,5C INC @ARG Make it real space [0911] 82F4 C8,51,5C CHE @ARG,@FAC7 Not enough!!!!! [0912] 82F7 77,DA BS ERRFE [0913] * The = check includes length byte [0914] 82F9 BC,B0,08 ST @FAC7,V*CCPADR Prestore string length 82FC 51 [0915] 82FD 91,08 DINC @CCPADR Update actual RAM address [0916] 82FF 90,06 INC @CCPPTR and internal column pointer [0917] 8301 43,08 BR OTHEZ0 [0918] 8303 D6,4C,65 OTHEZ1 CEQ STRVAL,@FAC2 Print the string result [0919] 8306 43,0D BR G830D [0920] 8308 06,97,11 OTHEZ0 CALL OSTRNG Output the string to the reco [0921] 830B 43,28 BR CHKSEP 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0016 FLMGR-359 [0922] 830D 86,55 G830D CLR @FAC11 Select standard BASIC format [0923] 830F 0F,73 XML XCNS Convert number to string [0924] 8311 06,96,0E CALL RSTRING Reserve and copy string [0925] 8314 06,97,11 CALL OSTRNG Output the string [0926] * Possibly add an extra space if we're not at the end of th [0927] * current record. [0928] 8317 C8,07,06 CHE @CCPPTR,@RECLEN Enough space left [0929] 831A 43,28 BR CHKSEP [0930] 831C BE,B0,08 ST SPACE,V*CCPADR Add trailing space 831F 20 [0931] 8320 A0,B0,08 ADD @DSRFLG,V*CCPADR Take care of screen I/O 8323 17 [0932] 8324 91,08 DINC @CCPADR Update current column address [0933] 8326 90,06 INC @CCPPTR and base 1 pointer [0934] 8328 06,96,2A CHKSEP CALL TSTSEP Check for legal delimiter [0935] 832B 41,09 BR ERRSYN Illegal delimiter. SYNTAX ERR [0936] * Unconditional branch [0937] * PRTAB - Print TAB as part of PRINT command [0938] 832D 06,83,C5 PRTAB CALL TSTINT Watch out for INTERAL file ty [0939] 8330 57,DA BR ERRFE They can't handle TABs [0940] 8332 0F,79 XML PGMCHR Skip TAB keyword [0941] 8334 D6,42,B7 CEQ LPARZ,@CHAT [0942] 8337 41,09 BR ERRSYN [0943] 8339 0F,74 XML PARSE Parse TAB expression [0944] 833B B6 BYTE RPARZ [0945] 833C 06,94,BB CALL CNVDEF Check and convert to integer [0946] 833F BC,4C,07 ST @RECLEN,@FAC2 Set modulo number [0947] 8342 06,96,1D CALL COMMOD Compute remainder [0948] 8345 C4,06,4B CH @FAC1,@CCPPTR Position on next output recor [0949] 8348 43,4F BR G834F [0950] 834A 06,96,A8 CALL OUTREC Output current record - no pe [0951] 834D 63,28 BS CHKSEP react on SIZE block!!! [0952] 834F D4,06,4B G834F CEQ @FAC1,@CCPPTR Stay here [0953] 8352 63,28 BS CHKSEP [0954] 8354 BC,03,4B ST @FAC1,@MNUM+1 Fill with spaces [0955] 8357 0F,84 XML IO OK, go ahead... fill'r up [0956] 8359 01 BYTE FILSPC [0957] 835A 43,28 BR CHKSEP And check separator again [0958] * Comma is similar to TAB, except that it generates at leas [0959] * one space. The exact number of spaces generated depends [0960] * upon the current position within the record. If the next [0961] * fixed tab-position is outside the record, the record, the [0962] * current record is output and the column pointer is reset [0963] * to column 1 of the next record. [0964] 835C BC,03,06 PRTCOM ST @CCPPTR,@MNUM+1 Compute initial # of spaces [0965] 835F 92,03 DEC @MNUM+1 Decrecment for 0 origin [0966] 8361 86,02 CLR @MNUM Clear high byte of double [0967] 8363 AE,02,0E DIV 14,@MNUM TABs are 14 spaces apart [0968] 8366 90,02 INC @MNUM Compute next TAB-stop [0969] 8368 AA,02,0E MUL 14,@MNUM and actual position [0970] 836B C4,07,03 CH @MNUM+1,@RECLEN Within this record [0971] 836E 43,77 BR PRCOL [0972] 8370 90,03 INC @MNUM+1 Convert to real position [0973] 8372 0F,84 XML IO Fill spaces to new location [0974] 8374 01 BYTE FILSPC [0975] 8375 43,7A BR PRSEM Outside current record [0976] * The ":" (colon) separator is used to output the current [0977] * record, and proceed to position 1 of the next record. [0978] 8377 06,96,A8 PRCOL CALL OUTREC Output the current record [0979] * The ";" (semi-colon) generates the null string. Since all [0980] * print items should be separated by a separator, this one [0981] * has been introduced to separate without moving to another [0982] * position. Notice that all separators join up here. [0983] 837A 0F,79 PRSEM XML PGMCHR Skip the separator 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0017 FLMGR-359 [0984] 837C 06,95,B0 CALL CHKEND Exit on end of line [0985] 837F 42,C9 BR CONPRT Continue if not end of line [0986] 8381 8E,17 PRSMZ1 CZ @DSRFLG For screen output continue [0987] 8383 63,A4 BS PREXIT [0988] 8385 DA,04,08 CLOG >08,@PABPTR Check SIZE clause [0989] 8388 63,A4 BS PREXIT [0990] 838A 06,96,A8 CALL OUTREC Output current record (blank [0991] 838D BC,06,09 ST @CCPADR+1,@CCPPTR Compute correct value for CCP [0992] 8390 A6,06,E1 SUB >E1,@CCPPTR Subtract current screen base [0993] 8393 43,A4 BR PREXIT and exit form this command [0994] * End of line exit routine for PRINT statement [0995] 8395 8E,17 EOLEX CZ @DSRFLG I/O - remove blocks if [0996] 8397 63,A1 BS G83A1 [0997] 8399 DA,04,04 CLOG >04,@PABPTR " AT" clause unused [0998] 839C 43,A1 BR G83A1 [0999] 839E B2,04,E7 AND >E7,@PABPTR remove flag 3 (SIZE used) [1000] 83A1 06,96,A8 G83A1 CALL OUTREC Output pending record [1001] * Continue here if record remains pending [1002] 83A4 8E,17 PREXIT CZ @DSRFLG Regular file/device I/O [1003] 83A6 43,B1 BR G83B1 [1004] 83A8 92,06 DEC @CCPPTR Back to actual offset [1005] 83AA BC,E0,03 ST @CCPPTR,V@OFS(@PABPTR) Save for next statement 83AD 04,06 [1006] 83AF 0F,75 XML CONT Continue with next statement [1007] * End external I/O handling [1008] * Reset of code is for internal I/O handling (VDP) [1009] 83B1 DA,04,04 G83B1 CLOG >04,@PABPTR Is not used [1010] 83B4 43,BB BR G83BB [1011] 83B6 BC,7F,06 ST @CCPPTR,@XPT Save current value of pointer [1012] 83B9 94,7F INCT @XPT CCPPTR: 1-28 [1013] 83BB DA,04,02 G83BB CLOG >02,@PABPTR Used BEEP clause [1014] 83BE 63,C3 BS G83C3 [1015] 83C0 06,00,34 CALL TONE1 ---------- BEEP ------------ [1016] 83C3 0F,75 G83C3 XML CONT Continue in PARSE routine [1017] * TSTINT - test for INTERAL type files, set COND if file [1018] * is NOT INTERNAL [1019] 83C5 8E,17 TSTINT CZ @DSRFLG Couldn't possibly be INTERNAL [1020] 83C7 53,8F BR RTC [1021] 83C9 DA,E0,05 CLOG >08,V@FLG(@PABPTR) Set COND according to bit 3 83CC 04,08 [1022] 83CE 01 RTNC Return without changing COND [1023] ********* PRINT / DISPLAY USING SECTION ******************* [1024] * Arrive here after the keyword "USING" has been rejected. [1025] 83CF 0F,7E USING XML SPEED [1026] 83D1 00 BYTE SYNCHK * Get first character of format [1027] 83D2 ED BYTE USINGZ * after (double) checking USIN [1028] 83D3 D6,42,C9 CEQ LNZ,@CHAT Pick up the line number [1029] 83D6 44,30 BR G8430 [1030] 83D8 0F,79 XML PGMCHR Get high address [1031] 83DA BC,4A,42 ST @CHAT,@FAC [1032] 83DD 0F,79 XML PGMCHR and low address [1033] 83DF BC,4B,42 ST @CHAT,@FAC1 [1034] 83E2 0F,79 XML PGMCHR get next program character [1035] 83E4 BD,4C,2E DST @EXTRAM,@FAC2 in SEETWO : EXTRAM value w [1036] * changed [1037] 83E7 0F,7E XML SPEED [1038] 83E9 03 BYTE SEETWO * Find the line # in the progr [1039] 83EA C1,4C,2E DEX @EXTRAM,@FAC2 result in SEETWO is in EXTRA [1040] * and restore EXTRAM value [1041] 83ED 44,5E BR USNGZ1 has to match exactly [1042] 83EF 95,4C DINCT @FAC2 Move up to the pointer field [1043] 83F1 BD,52,34 DST @DATA,@FAC8 Save DATA pointer for READ fi [1044] 83F4 06,91,A7 CALL GRSUB2 Read 2 bytes of data from ERA [1045] 83F7 4C BYTE FAC2 * @FAC2 : Source address on ERA 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0018 FLMGR-359 [1046] 83F8 BD,34,58 DST @EEE1,@DATA @EEE1 : Destination addr. on [1047] * Put it in @DATA [1048] 83FB BE,4C,A3 ST IMAGEZ,@FAC2 Search for an IMAGE token [1049] 83FE 06,8B,99 CALL SEARCH at beginning of an statement [1050] 8401 64,5E BS USNGZ1 Error if not found on this li [1051] 8403 06,93,07 CALL GETGFL Get first part of format stri [1052] 8406 06,93,26 CALL CHKSTR Prepare data for string assig [1053] 8409 BD,0C,50 DST @FAC6,@BYTES Copy actual string length in [1054] 840C BD,34,52 DST @FAC8,@DATA Restore original DATA pointer [1055] 840F 06,92,D0 CALL CTSTR Create a temporary string [1056] 8412 8F,50 DCZ @FAC6 [1057] 8414 64,2E BS G842E [1058] 8416 8E,80,84 CZ @RAMTOP Data from RAM [1059] 8419 44,23 BR G8423 [1060] 841B 34,50,B0 MOVE @FAC6,V*TEMP5,V*SREF 841E 1C,B0,66 [1061] 8421 44,2E BR G842E [1062] 8423 BD,56,50 G8423 DST @FAC6,@FFF1 FFF1 : byte count [1063] 8426 BD,54,66 DST @TEMP5,@DDD1 DDD1 : source address in ERAM [1064] 8429 BD,58,1C DST @SREF,@EEE1 EEE1 : destination address on [1065] 842C 0F,8B XML GVWITE Write data from ERAM to VDP [1066] 842E 44,38 G842E BR G8438 [1067] 8430 0F,74 G8430 XML PARSE Parse up to the ending ":" [1068] 8432 B5 BYTE COLONZ [1069] 8433 D6,4C,65 CEQ STRVAL,@FAC2 * IMAGE ERROR * [1070] 8436 44,5E BR USNGZ1 [1071] 8438 D6,42,B5 G8438 CEQ COLONZ,@CHAT Probably no variable list [1072] 843B 64,48 BS G8448 [1073] 843D 06,95,B0 CALL CHKEND We better check that through [1074] 8440 41,09 BR ERRSYN something sneaky sneaked in [1075] 8442 8E,51 CZ @FAC7 End of line exit [1076] 8444 63,95 BS EOLEX [1077] 8446 44,63 BR G8463 Look for format item [1078] 8448 8E,51 G8448 CZ @FAC7 Exclude null strings [1079] 844A 64,5E BS USNGZ1 [1080] 844C BD,5C,4E DST @FAC4,@ARG Get start address for string [1081] 844F BC,5E,51 ST @FAC7,@ARG2 Get format string length [1082] 8452 D6,B0,5C USNGZ0 CEQ >23,V*ARG Found no format item yet 8455 23 [1083] 8456 64,60 BS G8460 [1084] 8458 91,5C DINC @ARG Try next address [1085] 845A 92,5E DEC @ARG2 Update address [1086] 845C 44,52 BR USNGZ0 Try up to the end of the stri [1087] 845E 57,C6 USNGZ1 BR ERRIM * IMAGE ERROR [1088] * Now we're sure that we have at least one legal format ite [1089] * (anything with a "#" in it) [1090] 8460 BE,42,B3 G8460 ST COMMAZ,@CHAT Fake comma seperator for prin [1091] 8463 0F,77 G8463 XML VPUSH Current string might be tempo [1092] 8465 BD,0C,50 DST @FAC6,@BYTES Create a workstring for outpu [1093] 8468 90,0D INC @BYTES+1 Create space for end of strin [1094] 846A 0C CARRY String would be too long [1095] 846B 64,5E BS USNGZ1 [1096] 846D 0F,71 XML GETSTR Length whold equal format str [1097] 846F BD,14,1C DST @SREF,@CURLIN Create a temporary string [1098] 8472 A1,1C,50 DADD @FAC6,@SREF Compute last position in stri [1099] 8475 86,B0,1C CLR V*SREF Set end of string indicator [1100] 8478 BD,4E,E0 USNGZ3 DST V@4(@VSPTR),@FAC4 Update FAC4 area in case garb 847B 04,6E [1101] 847D 34,50,B0 MOVE @FAC6,V*FAC4,V*CURLIN Copy format 8480 14,B0,4E [1102] 8483 BD,4E,14 DST @CURLIN,@FAC4 Complete preps for VPUSH [1103] 8486 BF,4A,00 DST >001C,@FAC SREF = >001C 8489 1C [1104] 848A 91,50 DINC @FAC6 Include 0 in string length 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0019 FLMGR-359 [1105] 848C 0F,77 XML VPUSH Make the string temporary [1106] 848E BD,14,E0 DST V@4(@VSPTR),@CURLIN Update current line pointer 8491 04,6E [1107] 8493 D6,B0,14 USNGZ4 CEQ >23,V*CURLIN Try to locate the next format 8496 23 [1108] 8497 64,C3 BS G84C3 [1109] 8499 8E,B0,14 CZ V*CURLIN Not end of string yet [1110] 849C 64,A2 BS G84A2 [1111] 849E 91,14 DINC @CURLIN Update pointer if not found [1112] 84A0 44,93 BR USNGZ4 and continue searching [1113] 84A2 D6,42,B3 G84A2 CEQ COMMAZ,@CHAT Stop on last variable [1114] 84A5 45,C3 BR USNGZ9 [1115] 84A7 0F,78 XML VPOP Restore original workstring d [1116] 84A9 BC,0C,51 ST @FAC7,@BYTES Pring the current format stri [1117] 84AC 92,0C DEC @BYTES Don't count the last "0" [1118] 84AE BE,03,01 ST 1,@MNUM+1 Indicate direct output withou [1119] 84B1 06,97,1B CALL CHKRZ0 Copy string to output record [1120] 84B4 06,96,A8 CALL OUTREC Also output current record [1121] * FAC still contains the right data, however it is easier j [1122] * to copy the original string again. [1123] 84B7 BD,14,4E DST @FAC4,@CURLIN Reconstruct CRULIN [1124] 84BA 0F,78 XML VPOP Copy original string info [1125] 84BC 0F,77 XML VPUSH Without actually removing it [1126] 84BE A5,14,50 DSUB @FAC6,@CURLIN Reconstruct start address [1127] 84C1 44,78 BR USNGZ3 Continue for the next variabl [1128] 84C3 D5,14,E0 G84C3 DCEQ V@4(@VSPTR),@CURLIN Avoid "#" as count 84C6 04,6E [1129] 84C8 64,E9 BS USNZ42 [1130] 84CA 93,14 DDEC @CURLIN Backup to the sign [1131] 84CC D6,B0,14 CEQ >2E,V*CURLIN Used ".#####" 84CF 2E [1132] 84D0 44,DB BR G84DB [1133] 84D2 D5,14,E0 DCEQ V@4(@VSPTR),@CURLIN 84D5 04,6E [1134] 84D7 64,E9 BS USNZ42 [1135] 84D9 93,14 DDEC @CURLIN Avoid checking count bit [1136] 84DB D6,B0,14 G84DB CEQ >2D,V*CURLIN Check for minus 84DE 2D [1137] 84DF 64,E9 BS USNZ42 [1138] 84E1 D6,B0,14 CEQ >2B,V*CURLIN Check for plus 84E4 2B [1139] 84E5 64,E9 BS USNZ42 [1140] 84E7 91,14 DINC @CURLIN It's neither, so we undo [1141] * Check for availability of variables [1142] 84E9 D6,42,B3 USNZ42 CEQ COMMAZ,@CHAT Exit if no more pt item [1143] 84EC 45,C3 BR USNGZ9 [1144] 84EE 0F,79 XML PGMCHR Get next expression [1145] 84F0 A5,14,E0 DSUB V@4(@VSPTR),@CURLIN Make CURLIN offset for 84F3 04,6E [1146] * garbage collection [1147] 84F5 0F,74 XML PARSE Parse up to ";" or "," [1148] 84F7 B4 BYTE SEMICZ [1149] 84F8 A1,14,E0 DADD V@4(@VSPTR),@CURLIN Reconstruct new CLN after 84FB 04,6E [1150] * garbage collection [1151] 84FD 87,52 DCLR @FAC8 Start with clean sheet for co [1152] 84FF 87,55 DCLR @FAC11 [1153] 8501 86,57 CLR @FAC13 [1154] 8503 BD,0E,14 DST @CURLIN,@VAR4 Now start checking process [1155] 8506 D6,B0,14 CEQ >2E,V*CURLIN 8509 2E [1156] 850A 65,33 BS USNGZ5 [1157] 850C D6,B0,14 CEQ >23,V*CURLIN Has to be "+" or "-" 850F 23 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0020 FLMGR-359 [1158] 8510 65,27 BS G8527 [1159] 8512 D6,B0,14 CEQ >2D,V*CURLIN 8515 2D [1160] 8516 45,1B BR G851B [1161] 8518 B6,55,02 OR >02,@FAC11 Set explict sign flag for CNS [1162] 851B D6,B0,14 G851B CEQ >2B,V*CURLIN 851E 2B [1163] 851F 45,27 BR G8527 [1164] 8521 B6,55,02 OR >02,@FAC11 Set explict sign flag for CNS [1165] 8524 B6,55,04 OR >04,@FAC11 Set positive sign flag for CN [1166] 8527 06,85,E5 G8527 CALL ACCNM Accept first character plus " [1167] 852A BC,56,53 ST @FAC9,@FAC12 Set up FAC12 for CNS [1168] 852D D6,B0,0E CEQ >2E,V*VAR4 Found decimal point 8530 2E [1169] 8531 45,40 BR G8540 [1170] 8533 86,53 USNGZ5 CLR @FAC9 Prepare for use as counter of [1171] * of # sign after decimal poin [1172] 8535 06,85,E5 CALL ACCNM Accept some more "#"'s [1173] 8538 BC,57,53 ST @FAC9,@FAC13 Set up FAC13 for CNS [1174] 853B A0,53,56 ADD @FAC12,@FAC9 FAC9 now contains the total n [1175] * of "#" sign, decimal point a [1176] * maybe a sign bit [1177] 853E 92,53 DEC @FAC9 Exclude the decimal point [1178] 8540 D7,B0,0E G8540 DCEQ >5E5E,V*VAR4 Attempt to decode ^^ 8543 5E,5E [1179] 8545 45,64 BR USNZ55 [1180] 8547 95,0E DINCT @VAR4 Update address [1181] 8549 D7,B0,0E DCEQ >5E5E,V*VAR4 854C 5E,5E [1182] 854E 45,62 BR G8562 [1183] 8550 95,0E DINCT @VAR4 Update address [1184] 8552 B6,55,08 OR >08,@FAC11 Set E-format bit for CNS [1185] 8555 D6,B0,0E CEQ >5E,V*VAR4 8558 5E [1186] 8559 45,64 BR USNZ55 [1187] 855B 91,0E DINC @VAR4 Update end address [1188] 855D B6,55,10 OR >10,@FAC11 Set extended E-format bit for [1189] 8560 45,64 BR USNZ55 [1190] 8562 97,0E G8562 DDECT @VAR4 Correct for previous errors [1191] * At this point, CURLIN is pointing at the first item of th [1192] * format, VAR4 is pointing at the character following the i [1193] 8564 CA,4C,64 USNZ55 CHE >64,@FAC2 Detected numerical argument [1194] 8567 65,96 BS G8596 [1195] 8569 DA,55,02 CLOG >02,@FAC11 Exclude the sign count [1196] 856C 65,70 BS G8570 [1197] 856E 92,53 DEC @FAC9 FAC9 : Number of significant [1198] 8570 DA,55,08 G8570 CLOG >08,@FAC11 If E-format is used [1199] 8573 65,7C BS G857C [1200] 8575 CE,53,0A CGT >0A,@FAC9 More than 10 significant digi [1201] 8578 77,C6 BS ERRIM [1202] 857A 45,81 BR G8581 [1203] 857C CE,53,0E G857C CGT 14,@FAC9 More than 14 significant digi [1204] 857F 77,C6 BS ERRIM [1205] 8581 B6,55,01 G8581 OR >01,@FAC11 Set fixed format output it fo [1206] 8584 0F,73 XML XCNS 1 Convert number to fixed form [1207] * FAC11 points to the beginning of the string after supress [1208] * leading 0's, FAC12 contains the length of the string [1209] 8586 BC,57,55 ST @FAC11,@FAC13 FAC13 now point to beginning [1210] * the string [1211] 8589 86,55 CLR @FAC11 Clear high byte [1212] 858B 34,55,B0 MOVE @FAC11,*FAC13,V*CURLIN Copy the result string f 858E 14,90,57 [1213] * temporary [1214] 8591 BD,14,0E DST @VAR4,@CURLIN Move pointer behind print fie 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0021 FLMGR-359 [1215] 8594 44,93 BR USNGZ4 Continue after printing [1216] 8596 BD,54,0E G8596 DST @VAR4,@FAC10 Compute total length [1217] 8599 A5,54,14 DSUB @CURLIN,@FAC10 [1218] 859C C4,51,55 CH @FAC11,@FAC7 String exceeds limits [1219] 859F 45,B1 BR G85B1 [1220] 85A1 BE,00,2A ST >2A,@VAR0 Prepare a "*****.." string [1221] 85A4 BC,B0,14 G85A4 ST @VAR0,V*CURLIN Fill the remainder of field 85A7 00 [1222] 85A8 91,14 DINC @CURLIN Up to the end [1223] 85AA D5,14,0E USNZ67 DCEQ @VAR4,@CURLIN Which is stored in VAR4 [1224] 85AD 45,A4 BR G85A4 [1225] 85AF 44,93 BR USNGZ4 [1226] 85B1 8F,50 G85B1 DCZ @FAC6 [1227] 85B3 65,BE BS USNZ68 [1228] 85B5 34,50,B0 MOVE @FAC6,V*FAC4,V*CURLIN Copy result string 85B8 14,B0,4E [1229] 85BB A1,14,50 DADD @FAC6,@CURLIN And update address in string [1230] 85BE BE,00,20 USNZ68 ST SPACE,@VAR0 Fill remainder with spaces [1231] 85C1 45,AA BR USNZ67 [1232] 85C3 0F,78 USNGZ9 XML VPOP Temporary string back out [1233] 85C5 BC,0C,15 ST @CURLIN+1,@BYTES Output up to the current [1234] * position [1235] 85C8 A4,0C,4F SUB @FAC5,@BYTES Create one byte result [1236] 85CB 65,D3 BS USNZ95 Avoid empty strings [1237] 85CD BE,03,01 ST 1,@MNUM+1 Prevent skip if field too sma [1238] 85D0 06,97,1B CALL CHKRZ0 Preform all nomal I/O stuff [1239] 85D3 0F,78 USNZ95 XML VPOP Remove source format string [1240] 85D5 06,95,B0 CALL CHKEND Check for end of line exit [1241] 85D8 63,95 BS EOLEX Take end of line exit [1242] 85DA 0F,7E XML SPEED [1243] 85DC 00 BYTE SYNCHK * Then it HAS to be a ";" [1244] 85DD B4 BYTE SEMICZ [1245] 85DE 06,95,B0 CALL CHKEND Now - must be EOS [1246] 85E1 63,81 BS PRSMZ1 Supressed end of record, make [1247] * it a pending record [1248] 85E3 41,09 BR ERRSYN SYNTAX ERROR [1249] * Collect string of "#"'s [1250] 85E5 90,53 ACCNM INC @FAC9 Update item count [1251] 85E7 91,0E DINC @VAR4 and item address [1252] 85E9 D6,B0,0E CEQ >23,V*VAR4 Decode as many "#"'s as 85EC 23 [1253] * possible [1254] 85ED 65,E5 BS ACCNM [1255] 85EF 00 RTN Return from duty [1256] *********************************************************** [1257] * INPUT ROUTINE [1258] * First check for file or screen I/O. If file I/O then chec [1259] * for pending output and print that. If screen I/O then [1260] * check for input prompt: [1261] * Next collect the INPUT variable list on the V-stack. Get [1262] * enough input form either file or keyboard, and compare [1263] * types with entries on V-stack. After verification and [1264] * approval, assign the values. [1265] *********************************************************** [1266] 85F0 06,97,42 INPUT CALL INITKB Assume keyboard INPUT [1267] 85F3 D6,42,FD CEQ NUMBEZ,@CHAT Might be #0 or #1-255 [1268] 85F6 47,5A BR G875A [1269] 85F8 06,93,58 CALL CHKFN Check for default #0 [1270] 85FB 8F,4A DCZ @FAC If luno #0 [1271] 85FD 46,0B BR G860B [1272] 85FF BD,A3,AA DST @PGMPTR,V@INPUTP Save PGMPTR for "try again" 8602 2C [1273] 8603 91,A3,AA DINC V@INPUTP Pass the ":" for the [1274] * "prompt" code handler 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0022 FLMGR-359 [1275] * later, (using #0 will not [1276] * take care the prompt in [1277] * INPUT) [1278] 8606 06,89,2D CALL INPUZ2 #0 is equivalent to no # [1279] 8609 47,68 BR INPZ2 [1280] 860B 06,88,E8 G860B CALL INSU1 Get info about file [1281] * INTERNAL files get special treatment [1282] 860E DA,E0,05 CLOG >08,V@FLG(@PABPTR) INTERNAL file 8611 04,08 [1283] 8613 66,AD BS G86AD [1284] 8615 8E,E0,03 CZ V@OFS(@PABPTR) Fresh start 8618 04 [1285] 8619 46,1E BR G861E [1286] 861B 06,97,68 INTRZ0 CALL IOCLZ1 Get a new record through [1287] * the DSR [1288] 861E BC,2B,E0 G861E ST V@OFS(@PABPTR),@VARA+1 Regain possible offset 8621 03,04 [1289] 8623 86,2A CLR @VARA Make that a two byte constant [1290] 8625 BD,66,E0 DST V@BUF(@PABPTR),@TEMP5 Get first address 8628 06,04 [1291] 862A A1,66,2A DADD @VARA,@TEMP5 Compute actual address [1292] * within record [1293] 862D 06,97,E6 INTRZ1 CALL BUG01 Get the symbol table entry [1294] * Above call fixes bug, of the given variable [1295] 8630 0F,77 XML VPUSH And save it on the stack [1296] 8632 87,0C DCLR @BYTES Assume no data available [1297] 8634 C8,2B,E0 CHE V@CNT(@PABPTR),@VARA+1 Pick up data 8637 09,04 [1298] 8639 66,43 BS G8643 [1299] 863B BC,0D,B0 ST V*TEMP5,@BYTES+1 Length byte first 863E 66 [1300] 863F 91,66 DINC @TEMP5 Update both actual address [1301] 8641 90,2B INC @VARA+1 and offset [1302] 8643 D6,4C,65 G8643 CEQ >65,@FAC2 Has to be string variable [1303] 8646 46,50 BR G8650 [1304] 8648 BD,50,0C DST @BYTES,@FAC6 Set length of string [1305] 864B 06,92,E1 CALL CTMPST Create temporary string [1306] 864E 46,7E BR G867E [1307] 8650 D6,0D,08 G8650 CEQ >08,@BYTES+1 * FILE ERROR [1308] 8653 57,DA BR ERRFE [1309] 8655 34,0C,4A MOVE @BYTES,V*TEMP5,@FAC Copy value 8658 B0,66 [1310] 865A 8F,4A DCZ @FAC Watch out for non-scaled stuf [1311] 865C 66,7C BS G867C [1312] 865E BE,5C,51 ST FAC7,@ARG Test for legal numeric [1313] 8661 C6,90,5C G8661 CH 99,*ARG * FILE ERROR 8664 63 [1314] 8665 77,DA BS ERRFE [1315] 8667 92,5C DEC @ARG Next digit for test [1316] 8669 D6,5C,4B CEQ FAC1,@ARG [1317] 866C 46,61 BR G8661 [1318] 866E BD,5C,4A DST @FAC,@ARG Copy in ARG for some testing [1319] 8671 81,5C DABS @ARG Be sure we're positive [1320] * If first byte after expon. byte=0 : incorrect [1321] * normalization has occured : FILE ERROR [1322] * Or >99 : illegal numeric : FILE ERROR [1323] 8673 92,5D DEC @ARG1 0 would cause underflow here [1324] 8675 C6,5D,62 CH 98,@ARG1 [1325] 8678 77,DA BS ERRFE [1326] 867A 46,7E BR G867E [1327] 867C 87,4C G867C DCLR @FAC2 Be sure FAC2 = 0 (no strings) [1328] 867E A1,66,0C G867E DADD @BYTES,@TEMP5 Update address and [1329] 8681 A0,2B,0D ADD @BYTES+1,@VARA+1 offset again [1330] 8684 0F,7C XML ASSGNV Assign value to variable 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0023 FLMGR-359 [1331] 8686 86,E0,03 CLR V@OFS(@PABPTR) Undo allocated offsets 8689 04 [1332] 868A D6,42,B3 CEQ COMMAZ,@CHAT [1333] 868D 46,AB BR G86AB [1334] 868F 0F,79 XML PGMCHR Get next text character [1335] 8691 06,95,B0 CALL CHKEND Check for end of statement [1336] 8694 66,9F BS INTRZ2 OK, EOS is fine [1337] 8696 C8,2B,E0 CHE V@CNT(@PABPTR),@VARA+1 8699 09,04 [1338] 869B 66,1B BS INTRZ0 [1339] 869D 46,2D BR INTRZ1 Still something left [1340] 869F C8,2B,E0 INTRZ2 CHE V@CNT(@PABPTR),@VARA+1 86A2 09,04 [1341] 86A4 66,AB BS G86AB [1342] 86A6 BC,E0,03 ST @VARA+1,V@OFS(@PABPTR) Save value of offset 86A9 04,2B [1343] 86AB 0F,75 G86AB XML CONT And CONTINUE [1344] 86AD 06,92,8D G86AD CALL GETVAR Collect variable list on stac [1345] 86B0 BD,14,0A DST @STADDR,@CURLIN Save it in temp [1346] 86B3 BF,0A,08 DST CRNBUF,@RAMPTR Initialize crunch buffer poin 86B6 20 [1347] 86B7 86,07 CLR @RECLEN Initialize field counter [1348] 86B9 BE,E0,04 ST CZREAD,V@COD(@PABPTR) Select READ operation 86BC 04,02 [1349] 86BE 8E,E0,03 CZ V@OFS(@PABPTR) 86C1 04 [1350] 86C2 46,E9 BR INPZ31 [1351] 86C4 46,CC BR INPZ3 Adjust for used record usage [1352] 86C6 BE,EF,FF G86C6 ST COMMAZ,V@-1(@RAMPTR) Fake legal separator 86C9 FF,0A,B3 [1353] 86CC 06,97,68 INPZ3 CALL IOCLZ1 Get next input record [1354] 86CF 86,E0,03 CLR V@OFS(@PABPTR) Reset offset within record 86D2 04 [1355] 86D3 06,88,27 CALL RECENT [1356] 86D6 BC,2A,E0 ST V@CNT(@PABPTR),@VARA Get record length 86D9 09,04 [1357] 86DB 8E,2A G86DB CZ @VARA [1358] 86DD 66,E9 BS INPZ31 [1359] 86DF A2,B0,20 ADD OFFSET,V*VARW Add video offset for normal 86E2 60 [1360] 86E3 91,20 DINC @VARW Screen-type crunch - proceed [1361] 86E5 92,2A DEC @VARA for entire record [1362] 86E7 46,DB BR G86DB [1363] 86E9 06,88,27 INPZ31 CALL RECENT Compute actual record entry [1364] 86EC BC,2B,E0 ST V@CNT(@PABPTR),@VARA+1 Compute end of record 86EF 09,04 [1365] 86F1 86,2A CLR @VARA Make that a double byte [1366] 86F3 A1,2A,E0 DADD V@BUF(@PABPTR),@VARA Add buffer start addr 86F6 06,04 [1367] 86F8 93,2A DDEC @VARA Point to last position in rec [1368] 86FA 86,11 CLR @VAR6 Assume no values input [1369] 86FC 0F,7F XML CRUNCH Scan data fields as in DATA s [1370] 86FE 01 BYTE 1 * Indicate input stmt crunch [1371] 86FF 8F,22 DCZ @ERRCOD If some crunch error [1372] 8701 57,D2 BR ERRINP [1373] 8703 90,11 INC @VAR6 Get correct # of fields (one [1374] 8705 A0,07,11 ADD @VAR6,@RECLEN Update # of fields up to now [1375] 8708 C8,07,10 CHE @VAR5,@RECLEN OK, THAT'S ENOUGH!!!! [1376] 870B 46,C6 BR G86C6 [1377] 870D 97,2C DDECT @PGMPTR Backup program pointer [1378] 870F 0F,79 XML PGMCHR Re-inspect last token before [1379] 8711 06,88,27 CALL RECENT Precompute record entry [1380] 8714 86,E0,03 CLR V@OFS(@PABPTR) Assume no pending record 8717 04 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0024 FLMGR-359 [1381] 8718 D6,42,B3 CEQ COMMAZ,@CHAT Make record pending [1382] 871B 47,52 BR G8752 [1383] 871D D4,07,10 CEQ @VAR5,@RECLEN Enough left pending [1384] 8720 67,52 BS G8752 [1385] 8722 A4,07,10 SUB @VAR5,@RECLEN Compute remaining # of fields [1386] 8725 A4,11,07 SUB @RECLEN,@VAR6 # of fields used in last reco [1387] 8728 D6,B0,20 INPZ32 CEQ >82,V*VARW +OFFSET 872B 82 [1388] 872C 47,3A BR G873A Skip quoted strings [1389] 872E 91,20 G872E DINC @VARW [1390] 8730 D6,B0,20 CEQ >82,V*VARW +OFFSET 8733 82 [1391] 8734 47,2E BR G872E [1392] 8736 91,20 DINC @VARW [1393] 8738 47,28 BR INPZ32 Search for Nth data item [1394] 873A 91,20 G873A DINC @VARW Update pointer [1395] 873C D6,EF,FF CEQ >8C,V@-1(@VARW) * ","+OFFSET = >8C 873F FF,20,8C [1396] 8742 47,3A BR G873A [1397] 8744 92,11 DEC @VAR6 Commas denote end of field [1398] 8746 47,28 BR INPZ32 Continue until done [1399] 8748 A5,20,E0 DSUB V@BUF(@PABPTR),@VARW Compute current offset 874B 06,04 [1400] 874D BC,E0,03 ST @VARW+1,V@OFS(@PABPTR) Store for next round 8750 04,21 [1401] 8752 BC,11,10 G8752 ST @VAR5,@VAR6 Copy # of variables for check [1402] 8755 BD,0A,14 DST @CURLIN,@STADDR Restore from temp [1403] 8758 47,86 BR G8786 [1404] 875A 06,97,42 G875A CALL INITKB Initialize some variables for [1405] 875D BD,A3,AA DST @PGMPTR,V@INPUTP Save for "try agian" case 8760 2C [1406] 8761 BD,A3,BC DST @CCPPTR,V@CPTEMP Save CCPPTR, RECLEN for "try 8764 06 [1407] * Entry point for "try again" case [1408] 8765 06,89,06 INPZ33 CALL INSUB1 Put out prompt [1409] 8768 06,92,8D INPZ2 CALL GETVAR Get variable list on V-stack [1410] 876B 06,89,3B INPUZ3 CALL INSUB2 Read from the screen [1411] 876E 86,11 CLR @VAR6 Assume no values input [1412] 8770 0F,7F XML CRUNCH Crunch the input line [1413] 8772 01 BYTE 1 * Indicate input stmt scan [1414] 8773 BD,0A,14 DST @CURLIN,@STADDR Restore from temp [1415] 8776 8F,22 DCZ @ERRCOD If got some crunch error [1416] 8778 47,BB BR WRNINP [1417] 877A 0F,83 XML SCROLL Scroll up after crunching [1418] 877C BE,7F,03 ST 3,@XPT Reset XPT too - pending recor [1419] 877F 90,11 INC @VAR6 # fields = # of commas + 1 [1420] 8781 D4,10,11 CEQ @VAR6,@VAR5 # of variables wrong [1421] 8784 47,BB BR WRNINP [1422] * Once we're here, all information should be availiable [1423] * After type verification for input and variables, push [1424] * all value entries on the V-stack. [1425] * VAR6 = VAR5 = number of variables [1426] 8786 BD,14,34 G8786 DST @DATA,@CURLIN Save current DATA pointer [1427] 8789 BF,34,08 DST CRNBUF,@DATA Get crunch entry 878C 20 [1428] 878D BD,02,0E DST @VAR4,@MNUM Get entry in V-stack before P [1429] 8790 A3,02,00 INPUZ4 DADD 8,@MNUM Point to first symbol table e 8793 08 [1430] 8794 BD,06,B0 DST V*MNUM,@CCPPTR Get immedediate result 8797 02 [1431] 8798 06,93,0F CALL GETRAM Get value descriptor from RAM [1432] 879B DA,B0,06 CLOG >80,V*CCPPTR Numerical value 879E 80 [1433] 879F 47,CF BR G87CF 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0025 FLMGR-359 [1434] 87A1 06,92,EF CALL CHKNUM Check entered value against n [1435] 87A4 47,B4 BR INPUZ5 Found error [1436] 87A6 8E,17 CZ @DSRFLG Do not check overflow in file [1437] * supply machine infinity with [1438] * appropriate sign and continu [1439] 87A8 67,D4 BS INPUZ6 [1440] 87AA 8E,A3,BA CZ V@CSNTP1 Watch out for overflow in scr [1441] 87AD 67,D4 BS INPUZ6 [1442] 87AF BD,34,14 DST @CURLIN,@DATA Restore DATA pointer [1443] 87B2 47,BF BR WRZZ5 Ask for input re-enter [1444] 87B4 8E,17 INPUZ5 CZ @DSRFLG FILE I/O IS FATAL [1445] 87B6 77,D2 BS ERRINP [1446] 87B8 BD,34,14 DST @CURLIN,@DATA Restore DATA pointer on error [1447] 87BB 06,6A,82 WRNINP CALL WARNZZ Go here for simple warnings t [1448] 87BE 20 BYTE 32 * INPUT ERROR - TRY AGAIN [1449] 87BF 06,88,3A WRZZ5 CALL SCRZ Scroll the screen and reset C [1450] 87C2 BD,2C,A3 DST V@INPUTP,@PGMPTR Restore ptr to "prompt" if an 87C5 AA [1451] 87C6 BD,06,A3 DST V@CPTEMP,@CCPPTR Restore CCPPTR, RECLEN, for t 87C9 BC [1452] 87CA BD,6E,0E DST @VAR4,@VSPTR Restore original stack ptr [1453] 87CD 47,65 BR INPZ33 [1454] 87CF 06,93,26 G87CF CALL CHKSTR Check string input [1455] 87D2 67,B4 BS INPUZ5 ERROR ... CHECK I/O TYPE [1456] 87D4 06,93,0F INPUZ6 CALL GETRAM Get separation character (RAM [1457] 87D7 D6,01,B3 CEQ COMMAZ,@VAR0+1 [1458] 87DA 67,E6 BS G87E6 [1459] 87DC 92,11 DEC @VAR6 Has to be end of data [1460] 87DE 47,B4 BR INPUZ5 If not ... ERROR [1461] 87E0 8E,01 CZ @VAR0+1 [1462] 87E2 47,B4 BR INPUZ5 [1463] 87E4 47,EA BR G87EA [1464] 87E6 92,11 G87E6 DEC @VAR6 Count number of value entries [1465] 87E8 47,90 BR INPUZ4 Continue [1466] * Assign cycle - assign values to variables because it resc [1467] * the program line, this code can not be udes for inperativ [1468] * statements , since the crunch buffer get's destroyed on [1469] * input. The rescan is necessary because subscripts should [1470] * evaluated AFTER all previous values have been assigned. i [1471] * INPUT I,A(I) with values 2,3 [1472] * Should assign value 3 to A(2) !!!!!!!!! [1473] * No error-checking is done here, since types are already [1474] * validated. We might get subscripts out of range though!!! [1475] 87EA BF,34,08 G87EA DST CRNBUF,@DATA Prepare for input rescan 87ED 20 [1476] 87EE BD,2C,0A DST @STADDR,@PGMPTR Restore token pointer for res [1477] 87F1 93,2C DDEC @PGMPTR Backup on token [1478] 87F3 BD,6E,0E DST @VAR4,@VSPTR Restore original stack pointe [1479] 87F6 0F,79 INPZ65 XML PGMCHR Get next program characters [1480] 87F8 06,95,B0 CALL CHKEND Might have , before EOS [1481] 87FB 68,22 BS INPUZ7 [1482] 87FD 06,97,E6 CALL BUG01 Rescan variable name [1483] * Above call fixes bug. Get correct entry for arrays [1484] 8800 0F,77 XML VPUSH Save on stack for ASSGNV [1485] 8802 06,93,0F CALL GETRAM Get first token of input valu [1486] 8805 D6,4C,65 CEQ STRVAL,@FAC2 Numerical case [1487] 8808 68,0F BS G880F [1488] 880A 06,92,EF CALL CHKNUM Check for numerical value [1489] 880D 68,18 BS INPZ67 COND should be set (valid num [1490] 880F 06,93,26 G880F CALL CHKSTR Get the correct string value [1491] 8812 BD,0C,50 DST @FAC6,@BYTES Length for temporary string [1492] 8815 06,92,E1 CALL CTMPST Create temporary string [1493] 8818 0F,7C INPZ67 XML ASSGNV Assign value to variable [1494] 881A 06,93,0F CALL GETRAM Skip separator (already check 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0026 FLMGR-359 [1495] 881D 06,95,B0 CALL CHKEND Check for end to statement [1496] 8820 47,F6 BR INPZ65 Found it [1497] 8822 BD,34,14 INPUZ7 DST @CURLIN,@DATA Restore DATA pointer [1498] 8825 0F,75 XML CONT Contiue in PARSE [1499] 8827 BC,21,E0 RECENT ST V@OFS(@PABPTR),@VARW+1 Get record offset 882A 03,04 [1500] 882C 86,20 CLR @VARW Double byte value required [1501] 882E A1,20,E0 DADD V@BUF(@PABPTR),@VARW Got it 8831 06,04 [1502] 8833 00 RTN AND NOW, THE END IS NEAR... [1503] 8834 C7,08,02 CHKRM DCH SCRNBS+29,@CCPADR Not enough room for "?" 8837 FD [1504] 8838 48,40 BR G8840 [1505] 883A 0F,83 SCRZ XML SCROLL Scroll one line for "?" [1506] 883C BF,08,02 DST SCRNBS+2,@CCPADR and update CCPADR accordingl 883F E2 [1507] 8840 00 G8840 RTN [1508] *********************************************************** [1509] * LINPUT ROUTINE [1510] * If file-I/O then [1511] * Get file number and check it [1512] * Internal file not allowed [1513] * End if [1514] * Get variable info [1515] * Must be string variable [1516] * If file I/O then [1517] * If no-partial-record of REC clause included [1518] * Read new record [1519] * End if [1520] * Set up copy pointers [1521] * Else [1522] * Call readline to read from keyboard [1523] * Copy to crunch buffer adjustin g for screen offset [1524] * End if [1525] * Get string of proper length [1526] * Move data into string [1527] * Assign string [1528] * Done. [1529] *********************************************************** [1530] 8841 06,97,42 LINPUT CALL INITKB Assume input from keyboard [1531] 8844 D6,42,FD CEQ NUMBEZ,@CHAT If "#" - then device [1532] 8847 48,5C BR G885C [1533] 8849 06,93,58 CALL CHKFN Check for default = 0 [1534] 884C 8F,4A DCZ @FAC #0 is assumed [1535] 884E 68,5F BS LINP10 [1536] 8850 06,88,E8 CALL INSU1 Parse the device # [1537] 8853 DA,E0,05 CLOG >08,V@FLG(@PABPTR) 8856 04,08 [1538] 8858 57,DA BR ERRFE [1539] 885A 48,5F BR LINP10 [1540] 885C 06,89,06 G885C CALL INSUB1 Handle possible prompt [1541] 885F BD,0E,6E LINP10 DST @VSPTR,@VAR4 Save original V-pointer [1542] * incase BREAK in READLN [1543] 8862 06,97,E6 CALL BUG01 Get info about the symbol [1544] * Above call fixes bug. Get value pointer and type [1545] 8865 D6,4C,65 CEQ STRVAL,@FAC2 Must be string [1546] 8868 57,E2 BR ERRMUV [1547] 886A 0F,77 XML VPUSH [1548] 886C 8E,17 CZ @DSRFLG If device I/O [1549] 886E 48,AF BR G88AF [1550] 8870 8E,E0,03 CZ V@OFS(@PABPTR) If new record 8873 04 [1551] 8874 48,7B BR G887B [1552] 8876 06,97,68 CALL IOCLZ1 Read the record 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0027 FLMGR-359 [1553] 8879 48,93 BR G8893 [1554] 887B BC,0C,E0 G887B ST V@CNT(@PABPTR),@BYTES Get length of record 887E 09,04 [1555] 8880 BD,66,E0 DST V@BUF(@PABPTR),@TEMP5 Get address of buffer 8883 06,04 [1556] 8885 8E,0C G8885 CZ @BYTES While characters in buffer [1557] 8887 68,93 BS G8893 [1558] 8889 A6,B0,66 SUB OFFSET,V*TEMP5 Remove INPUT's offset 888C 60 [1559] 888D 91,66 DINC @TEMP5 Increment pointer [1560] 888F 92,0C DEC @BYTES Decrement count [1561] 8891 48,85 BR G8885 Drop out directly when done [1562] 8893 86,66 G8893 CLR @TEMP5 Need a word value [1563] 8895 BC,67,E0 ST V@OFS(@PABPTR),@TEMP5+1 Restore value 8898 03,04 [1564] 889A 86,0C CLR @BYTES Need a word value [1565] 889C BC,0D,E0 ST V@CNT(@PABPTR),@BYTES+1 Get the length 889F 09,04 [1566] 88A1 A5,0C,66 DSUB @TEMP5,@BYTES Calcualte length [1567] 88A4 A1,66,E0 DADD V@BUF(@PABPTR),@TEMP5 Current buffer address 88A7 06,04 [1568] 88A9 86,E0,03 CLR V@OFS(@PABPTR) Read next record next time 88AC 04 [1569] 88AD 48,E1 BR G88E1 Else if keyboard input [1570] 88AF 06,89,3B G88AF CALL INSUB2 Clear line and call READLN [1571] 88B2 87,0C DCLR @BYTES Initialize byte counter [1572] 88B4 BD,66,0A DST @RAMPTR,@TEMP5 Initialize "crunch" pointer [1573] 88B7 D6,B0,2A CEQ SPACE+OFFSET,V*VARA If space 88BA 80 [1574] 88BB 48,BF BR G88BF [1575] 88BD 93,2A DDEC @VARA Don't include space on end [1576] 88BF CD,20,2A G88BF DCGT @VARA,@VARW While not at end [1577] 88C2 68,DC BS G88DC [1578] 88C4 BC,00,B0 ST V*VARW,@VAR0 Get the character 88C7 20 [1579] 88C8 D6,00,7F CEQ EDGECH,@VAR0 If not at edge character [1580] 88CB 68,D8 BS G88D8 [1581] 88CD A6,00,60 SUB OFFSET,@VAR0 Subtract screen offset [1582] 88D0 BC,B0,0A ST @VAR0,V*RAMPTR And put into crunch buffer 88D3 00 [1583] 88D4 91,0C DINC @BYTES Count it [1584] 88D6 91,0A DINC @RAMPTR And update "crunch" pointer [1585] 88D8 91,20 G88D8 DINC @VARW Update input pointer [1586] 88DA 48,BF BR G88BF [1587] 88DC 0F,83 G88DC XML SCROLL Scroll the screen [1588] 88DE BE,7F,03 ST 3,@XPT Initialize x-pointer [1589] 88E1 06,92,E1 G88E1 CALL CTMPST Create temporary string [1590] 88E4 0F,7C XML ASSGNV Assign the value to it [1591] 88E6 0F,75 XML CONT And continue execution [1592] * Get file number and info about the file [1593] 88E8 06,93,74 INSU1 CALL CHKCON Check & convert & search [1594] 88EB 57,DA BR ERRFE Give error if required [1595] * INPUT allowed for input and update modes [1596] 88ED DA,E0,05 CLOG >02,V@FLG(@PABPTR) 88F0 04,02 [1597] 88F2 57,DA BR ERRFE [1598] 88F4 06,93,93 CALL OUTEOF Output pending PRINT stuff [1599] 88F7 BE,E0,04 ST CZREAD,V@COD(@PABPTR) Ensure read operation 88FA 04,02 [1600] 88FC 06,94,C5 CALL PARREC Parse REC clause [1601] 88FF 0F,7E XML SPEED Must be at a [1602] 8901 00 BYTE SYNCHK * colon else [1603] 8902 B5 BYTE COLONZ * its and error [1604] 8903 86,17 CLR @DSRFLG Clear keyboard input flag 99/4 GPL-ASSEMBLER (Pass 3) correct PAGE 0028 FLMGR-359 [1605] 8905 00 RTN [1606] * Parse and put out input prompt [1607] 8906 BD,0A,2C INSUB1 DST @PGMPTR,@STADDR Save pointer for prompt check [1608] 8909 93,0A DDEC @STADDR Backup to previous token [1609] * Go into a tight loop [1610] 890B 06,95,BD G890B CALL NXTCHR Get next program character [1611] 890E 69,27 BS INPZ37 Detected end of statement [1612] 8910 D6,42,B5 CEQ COLONZ,@CHAT Stop if we find a colon [1613] 8913 49,0B BR G890B [1614] 8915 BD,2C,0A DST @STADDR,@PGMPTR Backup for actual prompt scan [1615] 8918 0F,79 XML PGMCHR Jump into 1st char of prompt [1616] 891A 0F,74 XML PARSE And try to decode string expr [1617] 891C B5 BYTE COLONZ [1618] 891D D6,4C,65 CEQ STRVAL,@FAC2 Number prompt illegal [1619] 8920 57,C2 BR ERRSNM [1620] 8922 06,97,11 CALL OSTRNG Output the given prompt [1621] 8925 49,36 BR INPZ39 Exit without prompt backup [1622] 8927 BD,2C,0A INPZ37 DST @STADDR,@PGMPTR Backup to beginning of line [1623] 892A BE,42,B5 ST COLONZ,@CHAT Fake prompt with ":" [1624] 892D 06,88,34 INPUZ2 CALL CHKRM Check for room for ? [1625] 8930 BE,B0,08 ST >9F,V*CCPADR Display ? 8933 9F [1626] 8934 95,08 DINCT @CCPADR Count it too [1627] 8936 0F,7E INPZ39 XML SPEED Must be at a [1628] 8938 00 BYTE SYNCHK * colon else [1629] 8939 B5 BYTE COLONZ * its an error [1630] 893A 00 RTN [1631] * Issue 'BEEP' and call read line to read form screen [1632] 893B 06,88,34 INSUB2 CALL CHKRM Check for room for answer [1633] 893E BD,20,08 DST @CCPADR,@VARW Copy current cursor position [1634] 8941 BE,B0,08 G8941 ST >80,V*CCPADR Clear the remainder 8944 80 [1635] 8945 91,08 DINC @CCPADR of the current line [1636] 8947 CB,08,02 DCHE >02FE,@CCPADR Stop if we're there 894A FE [1637] 894B 49,41 BR G8941 [1638] 894D BF,A2,FE DST >7F7F,V@>02FE Replace edgechars 8950 7F,7F [1639] 8952 8E,80,CE CZ @PRTNFN If previous tone finished [1640] 8955 49,5A BR G895A [1641] 8957 06,00,34 CALL TONE1 ---------- BEEP ------------- [1642] 895A C1,6E,0E G895A DEX @VAR4,@VSPTR Don't destroy V-stack on BREA [1643] 895D 06,6A,76 CALL READLN Input a line from the keyboar [1644] 8960 C1,6E,0E DEX @VAR4,@VSPTR Restore V-stack pointer [1645] 8963 BD,14,0A DST @STADDR,@CURLIN Save in a temp [1646] 8966 BF,0A,08 DST CRNBUF,@RAMPTR Init crunch buffer pointer 8969 20 [1647] 896A 00 RTN GPL searches for names of XB routines or user defined routines like made by SUB or DEF or devices. Thus SIZE is a routine to show memory used or ACCEPT AT routine for limit and different tokens for each depending on how called. From EDITOR SIZE called alone such as SIZE enter key is not same as ACCEPT AT(row,col) SIZE number Quote Link to comment Share on other sites More sharing options...
+OLD CS1 Posted April 6 Share Posted April 6 16 hours ago, FarmerPotato said: Wow. Interesting bug testing, @OLD CS1 BTW, what I forgot to post was that I did see variable table entries for the three variables I created in that SUB statement: _X, Y, and _Z, where "_" is the byte >FB. What I did not, however, understand is the construction of the variable table entry. In a normal variable, you have the variable name followed by its value. In the case of SUB local variables, it appears to be a variable name, followed by some pointers, one of which points to the SUB definition. It was all sketchy when I looked at it, so I might misremember. At some point I would like to understand how the local variable table is built. Quote Link to comment Share on other sites More sharing options...
+FarmerPotato Posted April 6 Share Posted April 6 Edit: I put the link for the C.B. Wilson papers thread into my above post. That's where to find the full 255 page Basic specification. 1 Quote Link to comment Share on other sites More sharing options...
+Ksarul Posted April 7 Share Posted April 7 21 hours ago, FarmerPotato said: Edit: I put the link for the C.B. Wilson papers thread into my above post. That's where to find the full 255 page Basic specification. I somehow do not find the specification in that thread--but then, I may be missing something. . . Quote Link to comment Share on other sites More sharing options...
jschultzpedersen Posted April 7 Author Share Posted April 7 It is there all right on page 4, 2020 1. Feb in the original discussion. Quote Link to comment Share on other sites More sharing options...
+FALCOR4 Posted April 7 Share Posted April 7 1 hour ago, Ksarul said: I somehow do not find the specification in that thread--but then, I may be missing something. . . Yeah, I'm not seeing it there either and I've also been looking for it. I'm definitely missing something, too. Quote Link to comment Share on other sites More sharing options...
+Ksarul Posted April 7 Share Posted April 7 1 hour ago, jschultzpedersen said: It is there all right on page 4, 2020 1. Feb in the original discussion. The only document to be found on the fourth page of that post is the White Papers PDF, which does not contain the BASIC Specification document being quoted by @FarmerPotato. That is why I asked if he could post the whole document here. . .instead of the snippet he gave us. I HAD a mostly complete set of the CB Wilson documents, but I lost them in a computer crash a while back--while I was busy setting that machine up to back up the disk they were saved to. Quote Link to comment Share on other sites More sharing options...
Gary from OPA Posted April 7 Share Posted April 7 21 minutes ago, Ksarul said: The only document to be found on the fourth page of that post is the White Papers PDF, which does not contain the BASIC Specification document being quoted by @FarmerPotato. That is why I asked if he could post the whole document here. . .instead of the snippet he gave us. I HAD a mostly complete set of the CB Wilson documents, but I lost them in a computer crash a while back--while I was busy setting that machine up to back up the disk they were saved to. I second that, as I am missing pieces from my archives as well. So it would be good to refresh the complete set of the CB Wilson docs. Quote Link to comment Share on other sites More sharing options...
+FarmerPotato Posted April 10 Share Posted April 10 Here is the correct link, where the Specification was posted. 1 1 Quote Link to comment Share on other sites More sharing options...
Like us on Facebook
Follow us on Twitter
AtariAge on Instagram
Watch us on YouTube
Chat on Discord
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.