*********************************************************** TITL 'RXB 2024' GROM >8000 *********************************************************** * RAM EXPANSION ADDRESS CPUBAS EQU >A040 Expansion RAM base *********************************************************** * GROM ADDRESSES *********************************************************** * EQUATES FOR ROUTINES FROM OTHER GROM SECTIONS * GROM >0000 ATNZZ EQU >0022 Arctangent routine * GROM >6000 TOPL15 EQU >6012 RETURN FROM OLD or SAVE INITPG EQU >6014 Initialize program space TOPL10 EQU >601A Return to main and re-init KILSYM EQU >6022 KILL SYMBOL TABLE ROUTINE TOPL02 EQU >6030 RTN address for failing AUTOLOADER EDITLN EQU >6032 Edit a line into the program GWSUB EQU >6036 Write a few bytes of data to LLIST EQU >6A74 List a line READLN EQU >6A76 Read a line from keyboard WARNZZ EQU >6A82 WARNING MESSAGE ROUTINE ERRZZ EQU >6A84 ERROR MESSAGE ROUTINE READL1 EQU >6A86 Read a line from keyboard GTLIST EQU >7A06 GKXB address * GROM >A000 LITS05 EQU >A002 Literal string common code LINE EQU >A006 GET LINE NUMBER ROUTINE DATAST EQU >A008 SEARCH FOR NEXT "DATA" STATEM CONV1 EQU >A012 CONVERT WITH WARNING VALCD EQU >A016 CONVERT STRING TO NUMBER UBSUB EQU >A020 CLEAR BREAKPOINTS IN LN # TAB *********************************************************** * Equates for routine in MONITOR CALDSR EQU >10 CALL DEVICE SERVICE ROUTINE CFI EQU >12 CONVERT TO TWO BYTE INTEGER TONE1 EQU >34 ACCEPT TONE TONE2 EQU >36 BAD TONE CHAR2Z EQU >18 CHARACTER TABLE ADDRESS CHAR3Z EQU >4A CHARACTER TABLE ADDRESS *********************************************************** * Equates for XMLs SYNCHK EQU >00 SYNCHK XML selector FILSPC EQU >01 Fill-space utility CSTRIN EQU >02 Copy-string utility SEETWO EQU >03 SEETWO XML selector COMPCT EQU >70 PREFORM A GARBAGE COLLECTION GETSTR EQU >71 SYSTEM GET STRING MEMCHK EQU >72 MEMORY check routine: VDP XCNS EQU >73 Convert number to string * Warning Default changed in >0073 PARSE EQU >74 Parse a value CONT EQU >75 Continue parsing VPUSH EQU >77 Push on value stack VPOP EQU >78 Pop off value stack PGMCHR EQU >79 GET PROGRAM CHARACTER SYM EQU >7A Find SYMBOL entry SMB EQU >7B Also for ARRAYS ASSGNV EQU >7C Assign VARIABLE SCHSYM EQU >7D Search symbol table SPEED EQU >7E SPEED UP XML CRUNCH EQU >7F Crunch an input line CIF EQU >80 Convert INTEGER to FLOATING P CONTIN EQU >81 Continue after a break SCROLL EQU >83 SCROLL THE SCREEN IO EQU >84 IO utility (KW table search) GREAD EQU >85 READ DATA FROM ERAM GWRITE EQU >86 WRITE DATA TO ERAM DELREP EQU >87 REMOVE CONTENT FROM VDP/ERAM MVDN EQU >88 MOVE DATA IN VDP/ERAM MVUP EQU >89 MOVE DATA IN VDP/ERAM VGWITE EQU >8A MOVE DATA FROM VDP TO ERAM GVWITE EQU >8B WRITE DATA FROM GRAM TO VRAM GREAD1 EQU >8C READ DATA FROM ERAM GDTECT EQU >8E ERAM DETECT&ROM PAGE 1 ENABLE SCNSMT EQU >8F SCAN STATEMENT FOR PRESCAN *********************************************************** * Temporary workspaces in EDIT VAR0 EQU >8300 TEMPORARY VAR1 EQU >8301 TEMPORARY ACCUM EQU >8302 # OF BYTES ACCUMULATOR (4 BYTE STPT EQU >8302 TWO BYTES MNUM EQU >8302 Ussually a counter AAA1 EQU >8302 VARY EQU >8304 PABPTR EQU >8304 Pointer to current PAB VARY2 EQU >8306 Use in MVDN only DFLTLM EQU >8306 Default array limit (10) CCPPTR EQU >8306 OFFSET WITHIN RECORED (1) * or Pointer to current column RECLEN EQU >8307 LENGTH OF CURRENT RECORD (1) CCPADR EQU >8308 RAM address of current refs * or Actual buffer address or c VARC EQU >8308 CCPADD EQU >8308 RAM address of current color CCC1 EQU >8308 CALIST EQU >830A Call list for resolving refs RAMPTR EQU >830A Pointer for crunching STADDR EQU >830A Start address - usually for co BYTES EQU >830C BYTE COUNTER * or String length for GETSTR NMPTR EQU >830C Pointer save for pscan BBB1 EQU >830C CHSAV EQU >830E CURINC EQU >830E Increment for auto-num mode VAR4 EQU >830E TOPSTK EQU >8310 Top of data stack pointer VAR5 EQU >8310 VAR6 EQU >8311 LINUM EQU >8312 Used to determine end of scan NMLEN EQU >8314 Current line for auto-num CURLIN EQU >8314 Current line for auto-num * or Starting line number for L VAR9 EQU >8316 XFLAG EQU >8316 SCAN FLAG-BITS USED AS BELOW DSRFLG EQU >8317 INTERNAL =60, EXTERNAL =0 (1) OPTFLG EQU >8317 Option flag byte during OPEN FORNET EQU >8317 Nesting level of for/next FNUM EQU >8317 Current file number for search *********************************************************** * Permanent workspace variables STRSP EQU >8318 String space begining STREND EQU >831A String space ending SREF EQU >831C Temporary string pointer SMTSRT EQU >831E Start of current statement VARW EQU >8320 Screen address (CURSOR) ERRCOD EQU >8322 Return error code from ALC STVSPT EQU >8324 Value-stack base RTNG EQU >8326 Return vector from 9900 code NUDTAB EQU >8328 Start of NUD table VARA EQU >832A Ending display location PGMPTR EQU >832C Program text pointer (TOKEN) EXTRAM EQU >832E Line number table pointer STLN EQU >8330 Start of line number table ENLN EQU >8332 End of line number table DATA EQU >8334 Data pointer for READ LNBUF EQU >8336 Line table pointer for READ INTRIN EQU >8338 Add of intrinsic poly constant SUBTAB EQU >833A Subprogram symbol table IOSTRT EQU >833C PAB list/Start of I/O chain SYMTAB EQU >833E Symbol table pointer FREPTR EQU >8340 Free space pointer CHAT EQU >8342 Current charater/token BASE EQU >8343 OPTION BASE value PRGFLG EQU >8344 Program/imperative flag FLAG EQU >8345 General 8-bit flag BUFLEV EQU >8346 Crunch-buffer destruction leve LSUBP EQU >8348 Last subprogram block on stack * FAC EQU >834A Floating-point ACcurmulator FAC1 EQU FAC+1 FAC2 EQU FAC+2 AAA EQU FAC+2 FAC3 EQU FAC+3 FAC4 EQU FAC+4 CCC EQU FAC+4 FFF EQU FAC+4 FAC5 EQU FAC+5 FAC6 EQU FAC+6 BBB EQU FAC+6 EEE EQU FAC+6 FAC7 EQU FAC+7 FAC8 EQU FAC+8 FAC9 EQU FAC+9 FAC10 EQU FAC+10 DDD1 EQU FAC+10 FAC11 EQU FAC+11 FAC12 EQU FAC+12 FFF1 EQU FAC+12 FAC13 EQU FAC+13 FAC14 EQU FAC+14 EEE1 EQU FAC+14 FAC15 EQU FAC+15 FAC16 EQU FAC+16 FAC17 EQU FAC+17 * ARG EQU >835C Floating-point ARGument ARG1 EQU ARG+1 ARG2 EQU ARG+2 ARG3 EQU ARG+3 ARG4 EQU ARG+4 ARG5 EQU ARG+5 ARG6 EQU ARG+6 ARG7 EQU ARG+7 ARG8 EQU ARG+8 XSTLN EQU >8364 GKXB variable TEMP5 EQU >8366 ARG11 EQU ARG+11 ARG15 EQU ARG+15 ARG16 EQU ARG+16 * VSPTR EQU >836E Value stack pointer *********************************************************** * GPL Status Block HIVDP EQU >8370 Highest VDP available STACK EQU >8372 STACK FOR DATA KEYBD EQU >8374 KEYBOARD SELCTION RKEY EQU >8375 KEY CODE EXPZ EQU >8376 Exponent in floating-point RANDOM EQU >8378 RANDOM NUMBER GENERATOR TIMER EQU >8379 TIMING REGISTER MOTION EQU >837A NUMBER OF MOVING SPRITES VDPSTS EQU >837B VDP STATUS REGISTER ERCODE EQU >837C STATUS REGISTER *********************************************************** RAMTOP EQU >8384 Highest address in ERAM RAMFRE EQU >8386 Free pointer in the ERAM RSTK EQU >8388 Subroutine stack base * (Starts at >8A) RAMFLG EQU >8389 ERAM flag STKMIN EQU >83AF Base of data stack STKMAX EQU >83BD Top of data stack PRTNFN EQU >83CE Sound - previous tone finished *********************************************************** * VDP addresses SCRNBS EQU >02E0 Screen base addr for last lin NLNADD EQU >02E2 New LiNe ADDress ENDSCR EQU >02FE END of SCReen address START EQU >2372 Line to start execution at * Temporary CSNTMP EQU >0390 Use as temporary stored place * or CSN TEMPORARY FOR FAC12 AUTTMP EQU >2394 AUTOLD TEMPORARY IN SIDE ERRZ MRGPAB EQU >039E MERGEd temporary for pab ptr PMEM EQU >03A0 UPPER 24K MEMORY INPUTP EQU >23AA INPUT TEMPORARY FOR PTR TO PR ACCVRW EQU >23AC Temoporary used in ERRZZ, als * used in FLMGRS * or temporary for @VARW, @VARA ACCVRA EQU >23AE TRY AGAIN VALIDP EQU >03B0 Use as two values passing fro * or PTR TO STANDARD STRING IN VAL VALIDL EQU >23B2 VALIDATE code to READL1 * or Length of string in validate SIZCCP EQU >23B4 SIZE TEMPORARY FOR CCPADR SIZREC EQU >23B6 SIZE TEMPORARY FOR RECLEN * Also used as temporary in RELO *---------------------------------------------------------- ACCTRY EQU >23B7 ACCEPT "TRY AGAIN" FLAG SIZXPT EQU >23B8 Save XPT in SIZE when "try ag SAPROT EQU >23B9 PROTECTION flag in SAVE CSNTP1 EQU >03BA CSN TEMPORARY FOR FAC10 *---------------------------------------------------------- OLDTOP EQU >23BC Temporary used in ERRZZ, also * or Old top of memory for RELOCA CPTEMP EQU >23BC CCPPTR, RECLEN temp in INPUT NEWTOP EQU >23BE New top of memory for RELOCA VROAZ EQU >03C0 Temporary VDP Roll Out Area CRNBUF EQU >0820 CRuNch BUFfer address CRNEND EQU >08BE CRuNch buffer END RECBUF EQU >08C0 Edit RECall BUFfer VRAMVS EQU >0958 Default base of value stack *********************************************************** * IMMEDITATE VALUES NUMBR EQU >00 NUMERIC validate LISTZ EQU >02 OLDZ EQU >05 RESEQZ EQU >06 SAVEZ EQU >07 MERGEZ EQU >08 DWNARR EQU >0A UPARR EQU >0B CHRTN EQU >0D BKGD EQU >20 BACKGROUND CHARACTER OFFSET EQU >60 OFFSET FOR VIDEO TABLES STRVAL EQU >65 Value in accum. is string val *********************************************************** * Editting command equates BREAK EQU >02 Break key DLETE EQU >03 Delete key INSRT EQU >04 Insert key RECALL EQU >06 Edit-buffer recall CLRLN EQU >07 Clear-line key BACK EQU >08 Back-space key FORW EQU >09 Forward-space key DOWN EQU >0A Down-arrow key UPMV EQU >0B Up-arrow key VWIDTH EQU >1C Screen width (PRINT) SPACE EQU >20 Space key QUOTE EQU >22 " DOLLAR EQU >24 $ CURSOR EQU >1E+OFFSET CURSOR EDGECH EQU >1F+OFFSET EDGE character COMMA EQU >2C , MINUS EQU >2D - *********************************************************** * PAB offset CZOPEN EQU 0 OPEN CODE CZCLOS EQU 1 CLOSE CODE FIL EQU 2 File number within BASIC(0-25 CZREAD EQU 2 READ CODE OFS EQU 3 Offset within record CZWRIT EQU 3 WRITE CODE COD EQU 4 I/O code CZREST EQU 4 RESTORE/REWIND CODE FLG EQU 5 I/O mode flag byte CZLOAD EQU 5 LOAD CODE BUF EQU 6 Start of data buffer CZSAVE EQU 6 SAVE CODE CZDELE EQU 7 DELETE CODE LEN EQU 8 Record length CZSCR EQU 8 SCRATCH CODE CNT EQU 9 Character count CZSTAT EQU 9 STATUS CODE RNM EQU 10 Record number SCR EQU 12 Screen base offset NLEN EQU 13 Length of file descriptor PABLEN EQU 14 PAB LENGTH *********************************************************** * BASIC TOKEN TABLE * EQU >80 spare token ELSEZ EQU >81 ELSE SSEPZ EQU >82 :: TREMZ EQU >83 $ IFZ EQU >84 IF GOZ EQU >85 GO GOTOZ EQU >86 GOTO GOSUBZ EQU >87 GOSUB RETURZ EQU >88 RETURN DEFZ EQU >89 DEF DIMZ EQU >8A DIM ENDZ EQU >8B END FORZ EQU >8C FOR * LETZ EQU >8D LET * RXB REMOVED BREAKZ EQU >8E BREAK UNBREZ EQU >8F UNBREAK TRACEZ EQU >90 TRACE UNTRAZ EQU >91 UNTRACE INPUTZ EQU >92 INPUT DATAZ EQU >93 DATA RESTOZ EQU >94 RESTORE RANDOZ EQU >95 RANDOMIZE NEXTZ EQU >96 NEXT READZ EQU >97 READ STOPZ EQU >98 STOP DELETZ EQU >99 DELETE REMZ EQU >9A REM ONZ EQU >9B ON PRINTZ EQU >9C PRINT CALLZ EQU >9D CALL OPTIOZ EQU >9E OPTION OPENZ EQU >9F OPEN CLOSEZ EQU >A0 CLOSE SUBZ EQU >A1 SUB DISPLZ EQU >A2 DISPLAY IMAGEZ EQU >A3 IMAGE ACCEPZ EQU >A4 ACCEPT ERRORZ EQU >A5 ERROR WARNZ EQU >A6 WARNING SUBXTZ EQU >A7 SUBEXIT SUBNDZ EQU >A8 SUBEND RUNZ EQU >A9 RUN LINPUZ EQU >AA LINPUT * EQU >AB spare token (LIBRARY) * EQU >AC spare token (REAL) * EQU >AD spare token (INTEGER) * EQU >AE spare token (SCRATCH) * EQU >AF spare token THENZ EQU >B0 THEN TOZ EQU >B1 TO STEPZ EQU >B2 STEP COMMAZ EQU >B3 , SEMICZ EQU >B4 ; COLONZ EQU >B5 : RPARZ EQU >B6 ) LPARZ EQU >B7 ( CONCZ EQU >B8 & (CONCATENATE) * EQU >B9 spare token ORZ EQU >BA OR ANDZ EQU >BB AND XORZ EQU >BC XOR NOTZ EQU >BD NOT EQUALZ EQU >BE = LESSZ EQU >BF < GREATZ EQU >C0 > PLUSZ EQU >C1 + MINUSZ EQU >C2 - MULTZ EQU >C3 * DIVIZ EQU >C4 / CIRCUZ EQU >C5 ^ * EQU >C6 spare token STRINZ EQU >C7 QUOTED STRING UNQSTZ EQU >C8 UNQUOTED STRING NUMZ EQU >C8 ALSO NUMERICAL STRING NUMCOZ EQU >C8 ALSO UNQUOTED STRING LNZ EQU >C9 LINE NUMBER CONSTANT * EQU >CA spare token ABSZ EQU >CB ABS ATNZ EQU >CC ATN COSZ EQU >CD COS EXPZZ EQU >CE EXP INTZ EQU >CF INT LOGZ EQU >D0 LOG SGNZZ EQU >D1 SGN SINZ EQU >D2 SIN SQRZ EQU >D3 SQR TANZ EQU >D4 TAN LENZ EQU >D5 LEN CHRZZ EQU >D6 CHR$ RNDZ EQU >D7 RND SEGZZ EQU >D8 SEG$ POSZ EQU >D9 POS VAL EQU >DA VAL STRZZ EQU >DB STR$ ASCZ EQU >DC ASC PIZ EQU >DD PI RECZ EQU >DE REC MAXZ EQU >DF MAX MINZ EQU >E0 MIN RPTZZ EQU >E1 RPT$ * EQU >E2 unused * EQU >E2 unused * EQU >E3 unused * EQU >E4 unused * EQU >E5 unused * EQU >E6 unused * EQU >E7 unused NUMERZ EQU >E8 NUMERIC DIGITZ EQU >E9 DIGIT UALPHZ EQU >EA UALPHA SIZEZ EQU >EB SIZE ALLZ EQU >EC ALL USINGZ EQU >ED USING BEEPZ EQU >EE BEEP ERASEZ EQU >EF ERASE ATZ EQU >F0 AT BASEZ EQU >F1 BASE * EQU >F2 spare token (TEMPORARY) VARIAZ EQU >F3 VARIABLE RELATZ EQU >F4 RELATIVE INTERZ EQU >F5 INTERNAL SEQUEZ EQU >F6 SEQUENTIAL OUTPUZ EQU >F7 OUTPUT UPDATZ EQU >F8 UPDATE APPENZ EQU >F9 APPEND FIXEDZ EQU >FA FIXED PERMAZ EQU >FB PERMANENT TABZ EQU >FC TAB NUMBEZ EQU >FD # VALIDZ EQU >FE VALIDATE * EQU >FF ILLEGAL VALUE *********************************************************** TITL 'FLMGR-359' *********************************************************** * GROM HEADER *********************************************************** * Branch table routines *********************************************************** BR DISPL1 DISPLAY routine BR DELET DELETE routine BR PRINT PRINT routine BR INPUT INPUT routine (not yet impele BR OPEN OPEN routine BR CLOSE CLOSE routine BR RESTOR RESTORE routine BR READ READ routine BR GETDAT Get DATA from ERAM/VDP (not u BR CLSALL CLOSE ALL OPEN FILES subrouti BR SAVE SAVE routine BR OLD LOAD routine BR LIST LIST routine BR OUTREC Output record routine BR EOF End of file routine BR ACCEPT ACCEPT routine BR SRDATA Search "DATAZ" routine BR SUBREC RECORD routine BR CHKEND Check EOS BR OLD1 A subroutine for LOAD BR MERGE MERGE a program BR GRMLST List a line out of ERAM BR GRSUB2 Read 2 bytes of data from ERA BR GRSUB3 Read 2 bytes of data from ERA * with resetting possible break BR LINPUT LINPUT statement *********************************************************** * OPEN STATEMENT HANDLER * Handle the BASIC OPNE statement. A legal syntax can only * be something like * OPEN #{exp}:{string-exp}[,{open-options}] * in which {open-option} is any of the following * DISPLAY, INPUT, VARIABLE, RELATIVE, INTERNAL, SEQUENTIAL, * OUTPUT, UPDATE, APPEND, FIXED or PERMANENT * * Each keyword can only be used once, which is being checke * with an OPTFLG-bit. For each specific option please refer * to the related routine. * Scanning stops as soon as no next field starting with a * comma can be found. * NOTE: After the actual DSR OPEN has been preformed, the * length of the record, whether VARIABLE or FIXED, * has to be non-zero. A zero length will cause an * INCORRECT STATEMENT error. *********************************************************** OPEN CALL CHKFN See if we specified any file BS ERRFE Definitely not... no # or #0 CALL CHKCON Check and search given filenu BS ERRFE *** FILE NUMBER EXISTS *** * ERROR IF NOT STOPPED ON COLON XML SPEED Must be at a BYTE SYNCHK * colon or else BYTE COLONZ * its an error CALL PARFN Parse filename and create PAB DDEC @PGMPTR Backup pgm pointer for next t OPTION XML PGMCHR Get next program character * Next field should start with a comma OPTIZ0 CEQ COMMAZ,@CHAT BR CHECK * Enter HERE after comma exit in "SEQUENTIAL" OPTIZ1 XML PGMCHR Next token please... * Treat DISPLAY and INPUT as special cases CEQ DISPLZ,@CHAT BS OPTZ6 CEQ INPUTZ,@CHAT BS OPTZ7 SUB VARIAZ,@CHAT Reduce keyword offset to 0 CHE 9,@CHAT Keyword to high BS OPERR CASE @CHAT JUST IN CASE BR OPTZ01 Option VARIABLE BR OPTZ02 RELATIVE BR OPTZ03 INTERNAL BR OPTZ1 SEQUENTIAL BR OPTZ2 OUTPUT BR OPTZ3 UPDATE BR OPTZ4 APPEND BR OPTZ5 FIXED * BR OPTZ0 PERMANENT <<<<<< * CASE 0 - "PERMANENT" ************************************ * Only check for multiple usage. Since PERMANENT is the * default, we might as well ignore it... OPTZ0 CLOG >04,@OPTFLG BR OPERR OR >04,@OPTFLG Not used ... use now BR OPTION Treat as simple default * CASE 2 - "RELATIVE" ************************************* * Select relative record file in PAB and fall through in * SEQUENTIAL code for multiple usage check. Also handle * initial file-size there. OPTZ02 OR >01,V@FLG(@PABPTR) Indicate RELATIVE RECORD * CASE 4 - "SEQUENTIAL" *********************************** * Checks for multiple usage. Remainder of syntax demads th * we have something like: * [{numeric expression}],... * In case only a comma is found, we use the default. * Everything else has to be evaluated as a numeric * expression, convertable to a 16-bit integer value. OPTZ1 CLOG >08,@OPTFLG BR OPERR OR >08,@OPTFLG First time usage, ok XML PGMCHR Check next token for default * Comma means default has been used CEQ COMMAZ,@CHAT BS OPTIZ1 CALL CHKEND Check for end of statement BS CHECK CALL CHKPAR Preform combined checking & p DST @FAC,V@RNM(@PABPTR) Non-zero result BR OPTIZ0 Scan other options * Parse and check a numeric argument in here.... CHKPAR XML PARSE If not ... parse up to comma BYTE COMMAZ CALL CHKCNV Check and convert to integer BS OPERR Oops..., someone made a mista RTN Return to caller * CASE 5 - "OUTPUT" *************************************** * Select mode code "01" and check for multiple usage. Use * MFLAG bit in OPTFLG for checking. OPTZ2 OR >02,V@FLG(@PABPTR) Mode code = 01 * CASE 6 - "UPDATE" *************************************** * Default ... Check for multiple usage only... * Test for previous usage of any mode setting OPTZ3 CLOG >01,@OPTFLG BR OPERR OR >01,@OPTFLG If not... set "MODE USED" bit BR OPTION Continue option scan * CASE 7 - "APPEND" *************************************** * Mode code "11" indicates APPEND mode. OPTZ4 OR >06,V@FLG(@PABPTR) Mode code = 11 BR OPTZ3 * CASE 1 - "VARIABLE" ************************************* * Change record type to VARIABLE and continue as FIXED OPTZ01 OR >10,V@FLG(@PABPTR) Indicate variable length mo * CASE 8 - "FIXED" **************************************** * Fixed is default. Don't change anything, unless argument * is given. In this case evaluate as numeric expression an * check for 8-bit integer range... * This routine is also used for VARIABLE !!!!! OPTZ5 XML PGMCHR Get next character CEQ COMMAZ,@CHAT Could be some argument BS OPTZ55 CALL CHKEND Could also be end of statemen BS OPTZ55 It is an EOS CALL CHKPAR Check & parse expression * Check for byte overflow (records can only be up to 255 * bytes in length) CZ @FAC BR OPERR ST @FAC1,V@LEN(@PABPTR) Select non-zero rec-size OPTZ55 CLOG >10,@OPTFLG BR OPERR OR >10,@OPTFLG Prevent to much usage of mode BR OPTIZ0 Continue option scan * CASE 3 - "INTERNAL" ************************************* * Select INTERANL file type and continue in DIPLAY OPTZ03 OR 8,V@FLG(@PABPTR) Select INTERNAL type * CASE 9 - "DISPLAY" ************************************** * Default. Only check for multiple usage of either DISPLAY * or INTERNAL... OPTZ6 CLOG >02,@OPTFLG BR OPERR OR >02,@OPTFLG Else set "DISPLAY/INTERAL" fl BR OPTION Continue... DISPLAY is defaul * CASE 10 "INPUT" ***************************************** * Same as any other I/O type definition. Mode code "10" .. * Continue in OPTZ3 OPTZ7 OR >04,V@FLG(@PABPTR) Mode code = 10 BR OPTZ3 * CLRFRE deallocates previously alocated (parts of) PAB's a * return with an error message CLRFRE CLR @MNUM Undo any allocation ST V@OFS(@PABPTR),@MNUM+1 We need the length for * that * V@OFS(@PABPTR) Was set up in PARFN routine DADD @MNUM,@FREPTR Update the first free world RTN And return OPERR CALL CLRFRE First undo the allocation ERRSYN CALL ERRZZ Then give an error BYTE 3 * SYNTAX ERROR * Continue with CHECK to conplete the actual OPEN CHECK CALL CHKEND Check EOS BR OPERR Not EOS : SYNTAX ERROR * If the user hasn't specified VARIABLE or FIXED, the * default specification depends on the file type. * Change current default (=VARIABLE) to FIXED for * RELATIVE files. CLOG >01,V@FLG(@PABPTR) RELATIVE RECORD BS G8127 CLOG >10,V@FLG(@PABPTR) VARIABLE RECORD BS G8125 FILZZ CALL CLRFRE Undo the PAB allocation BR ERRFE FILE ERROR G8125 BR G8131 Sequential file, check rec. m G8127 CLOG >10,@OPTFLG No definition yet BR G8131 OR >10,V@FLG(@PABPTR) Force VARIABLE mode G8131 CALL CDSR Call the DSR, return with err BR ERRZ2B indication in COND... DCLR V@RNM(@PABPTR) Make sure we start with recor * Check for undefined record length. The record length for * any type might be defined by the DSR CZ V@LEN(@PABPTR) BS FILZZ ST V@LEN(@PABPTR),@MNUM+1 Get record length CLR @MNUM Create two byte result and CLR V@OFS(@PABPTR) allocate - remove offset for * later use DST @MNUM,@FAC - prepare for space claim * Check for special case : no PAB's yet DCZ @IOSTRT BR G8157 DST @PABPTR,@IOSTRT Simply enter the first pointe BR G8169 G8157 DST @IOSTRT,@STADDR Search for the end of the cha G815A DCZ V*STADDR BS G8165 DST V*STADDR,@STADDR Keep on deferring BR G815A G8165 DST @PABPTR,V*STADDR Update last chain link G8169 DST @PABPTR,V@BUF(@PABPTR) Set empty buffer first XML MEMCHK Check memory overflow & strin BS ERRMEM * MEMORY FULL DSUB @MNUM,@FREPTR Compute buffer entry address DSUB @MNUM,V@BUF(@PABPTR) Correct buffer address in XML CONT Return to the parser *********************************************************** * DELETE ROUTINE * Use file # 0 for this operation. Parse the file name * string-expression as usual, and delete the PAB before * actually calling the DSR. *********************************************************** DELET CLR @FNUM Create file #0 - non-existing CALL PARFN Handle as normal PAB OPEN CALL CHKEND Check EOS first BR OPERR Not EOS : go undo PAB allocat * and print SYNTAX ERROR CLR @MNUM * Delete PAB again before calling ST V@OFS(@PABPTR),@MNUM+1 Create double byte PAB DADD @MNUM,@FREPTR Update free word pointer CALL IOCALL Preform I/O call for actual d BYTE CZDELE XML CONT *********************************************************** * CLOSE ROUTINE * Syntax could be * CLOSE #{ num exp } or CLOSE #{ num exp }:DELETE * * Possibly output pending records before closing or * deleting the file. *********************************************************** CLOSE CALL CHKFN Check for "no #" / "#0" cases BS ERRFE Not for "CLOSE" you don't CALL CHKCON Check file number etc... BR ERRFE *** FILE NUMBER NOT IN SYSTEM CALL OUTEOF Output pending records ST CZCLOS,V@COD(@PABPTR) Default to CLOSE I/O code CEQ COLONZ,@CHAT Check for ":DELETE" spec. BR G81B8 XML PGMCHR Request next input token XML SPEED Must be at a BYTE SYNCHK * "DELETE" else BYTE DELETZ * its an error ST CZDELE,V@COD(@PABPTR) Change CLOSE to DELETE G81B8 CALL CHKEND EOS? BR ERRSYN NO:SYNTAX ERROR CALL CDSR Call DSR with whatever we hav BR CLOSZ1 Reset means error.... CALL DELPAB Delete PAB and data-buffer XML CONT Return to parser routine CLOSZ1 DST V@4(@PABPTR),@ARG Save error code for message CALL DELPAB Now delete the PAB DST @FREPTR,@PABPTR Store error-code in free memo DSUB 6,@PABPTR Create standard size PAB DST @ARG,V@4(@PABPTR) Copy error-code BR ERRIO Exit to error-routine *********************************************************** * CLOSE ALL ROUTINE * CLOSE all the existing PABs ... ignore errors * * NOTE: "CLSLBL" is used in the I/O error routine to * determine if a warning should be given rather than * an error. *********************************************************** G81DD DST V*PABPTR,@PABPTR CLSAZ0 DCZ V*PABPTR Find last PAB in chain BR G81DD CALL OUTEOF Take care of pending records CLSLBL ST CZCLOS,V@COD(@PABPTR) Select CLOSE code CALL CDSR CLOSE to DSR routine CALL DELPAB Delete PAB - ignore CLOSE err CLSALL DST @IOSTRT,@PABPTR Start at beginning of chain DCZ @IOSTRT Continue until done BR CLSAZ0 RTN And return *********************************************************** * RESTORE ROUTINE * RESTORE can have any of four forms: * * RESTORE Restore to first DATA * RESTORE 20 Restore DATA pointer * RESTORE #1 Rewind file number 1 * RESTORE #1, REC 2 Position file 1 at record 2 *********************************************************** RESTOR DCLR @FAC Assume simple RESTORE CEQ NUMBEZ,@CHAT BR OLDCD CALL CHKFN Check for # DCZ @FAC Found equivalent of #0 BS OLDCZ0 CALL CHKCON Check and decode file # BR ERRFE Give error if file not there CALL OUTEOF Output pending record DCLR V@RNM(@PABPTR) Initialize to record 0 CALL PARREC Parse possible record clause CALL IOCALL Call DSR routine with BYTE CZREST * RESTORE I/O code XML CONT Return if no error found * Following code is for handling RESTORE to line number * within program OLDCD CALL CHKEND Check for start with end BS OLDCZ0 If we have anything else CALL LINE in FAC (double) OLDCZ0 DCEQ @ENLN,@STLN BR G8233 WRNNPP CALL WARNZZ * NO PROGRAM PRESENT * BYTE 29 B TOPL15 Go back to toplevel G8233 DST @ENLN,@LNBUF Start at beginning of program DSUB 3,@LNBUF Backup for first line number * Check against given line number OLDCZ1 CALL GRSUB3 Read 2 bytes of line ptr from * line # table which is in ERA BYTE LNBUF * Source address on ERAM/VDP * @EEE1: Destination addr on CP DCH @EEE1,@FAC Try to get something higher BR G824E DCEQ @STLN,@LNBUF Last line in program BS ERRDAT DSUB 4,@LNBUF Get next entry in line # tabl BR OLDCZ1 Try again with next line G824E DADD 3,@LNBUF Undo subtraction CALL DATAST Setup pointer for READ XML CONT Continue PARSE *********************************************************** * DISPLAY ROUTINE * DISPLAY handles all random screen access stuff.. * the AT-clause, and the BEEP, ERASE ALL and SIZE clause. *********************************************************** DISPL1 CALL DISACC Evaluate DISPLAY options BS EOLEX EXIT directly on end-of-state * If anything is specified it has to be a colon CZ @PABPTR Nothing was specified BS PRINZ1 * At this point we MUST have a colon, or else we error off * (SYNTAX ERROR) XML SPEED Check for a colon BYTE SYNCHK * and continue BYTE COLONZ * it approved BR PRINZ1 Continue with PRINT items *********************************************************** * PRINT ROUTINE * MAIN-HANDLER FOR ALL PRINT-FUNCTIONS *********************************************************** PRINT CALL INITKB Initialize keyboard I/O CEQ NUMBEZ,@CHAT Could still be anything BR PRINZ1 CALL CHKFN Check if default or open chan DCZ @FAC Default intended BS PRNZ10 CALL CHKCON Check and convert expression BR ERRFE Error if PAB not in system * PRINT allowed in output, append or update modes * Not allowed in input mode CLOG >04,V@FLG(@PABPTR) BS G8288 CLOG >02,V@FLG(@PABPTR) BS ERRFE G8288 CEQ CZREAD,V@COD(@PABPTR) BR G8293 CLR V@OFS(@PABPTR) Unpend pending INPUTs G8293 ST CZWRIT,V@COD(@PABPTR) uncomplete PRINTs CALL PRINIT Initialize some variables * Next character has to be either EOL, COMMA, or COLON CALL CHKEND BS EOLEX exit on end of statement CALL PARREC Parse possible record clause BS PRINZ0 found "," but no REC clause PRNZ10 CALL CHKEND BS EOLEX Exit on end of statement for * "PRINT #0" or "PRINT file position" CEQ COMMAZ,@CHAT BR G82BE XML PGMCHR Get next in line PRINZ0 CZ @PABPTR For "PRINT #0" BS USING * Interal type of file? CLOG >08,V@FLG(@PABPTR) BR ERRFE BR USING Execute USING clause G82BE XML SPEED Must be at a BYTE SYNCHK * colon at this point BYTE COLONZ * and error off on others BR CONPRT Make it a short branched ELSE PRINZ1 CEQ USINGZ,@CHAT BS USING End standard initialization * Test standard separators CONPRT CALL TSTSEP Test separator character CEQ TABZ,@CHAT Handle TABs BS PRTAB * At this point we've checked TAB and ; , : * The only remaining print items have to be expressions * All expressions are being handled below. * If the result of the expression is a numeric, the string * is transformed into a string and printed. Strings are * printed "as is". * The code for strings and converted numerics cannot be ma * common, since numerics may require an extra space behind * the item, depending upon the current position in the reco * Either way, the string is chunked up into little pieces * it won't fit in an empty record. XML PARSE Evaluate the expression BYTE COLONZ * Special code for INTERNAL file handling * Translate numeric datums into string format and indicate * length 8. Then check to see if the item fits within the * current record. If not, it is an error, since each item * has to fit. CALL TSTINT Test for internal files BS OTHEZ1 Nope, something different CEQ STRVAL,@FAC2 Change numerics BS G82EC ST 8,@FAC12 To string length 8 MOVE 8,@FAC,@ARG Save in ARG ST ARG,@FAC11 And use this as source CALL RSTRING Reserve some string space G82EC ST @RECLEN,@ARG Compute remaining space to EO SUB @CCPPTR,@ARG for space checking INC @ARG Make it real space CHE @ARG,@FAC7 Not enough!!!!! BS ERRFE * The = check includes length byte ST @FAC7,V*CCPADR Prestore string length DINC @CCPADR Update actual RAM address INC @CCPPTR and internal column pointer BR OTHEZ0 OTHEZ1 CEQ STRVAL,@FAC2 Print the string result BR G830D OTHEZ0 CALL OSTRNG Output the string to the reco BR CHKSEP G830D CLR @FAC11 Select standard BASIC format XML XCNS Convert number to string CALL RSTRING Reserve and copy string CALL OSTRNG Output the string * Possibly add an extra space if we're not at the end of th * current record. CHE @CCPPTR,@RECLEN Enough space left BR CHKSEP ST SPACE,V*CCPADR Add trailing space ADD @DSRFLG,V*CCPADR Take care of screen I/O DINC @CCPADR Update current column address INC @CCPPTR and base 1 pointer CHKSEP CALL TSTSEP Check for legal delimiter BR ERRSYN Illegal delimiter. SYNTAX ERR * Unconditional branch * PRTAB - Print TAB as part of PRINT command PRTAB CALL TSTINT Watch out for INTERAL file ty BR ERRFE They can't handle TABs XML PGMCHR Skip TAB keyword CEQ LPARZ,@CHAT BR ERRSYN XML PARSE Parse TAB expression BYTE RPARZ CALL CNVDEF Check and convert to integer ST @RECLEN,@FAC2 Set modulo number CALL COMMOD Compute remainder CH @FAC1,@CCPPTR Position on next output recor BR G834F CALL OUTREC Output current record - no pe BS CHKSEP react on SIZE block!!! G834F CEQ @FAC1,@CCPPTR Stay here BS CHKSEP ST @FAC1,@MNUM+1 Fill with spaces XML IO OK, go ahead... fill'r up BYTE FILSPC BR CHKSEP And check separator again * Comma is similar to TAB, except that it generates at leas * one space. The exact number of spaces generated depends * upon the current position within the record. If the next * fixed tab-position is outside the record, the record, the * current record is output and the column pointer is reset * to column 1 of the next record. PRTCOM ST @CCPPTR,@MNUM+1 Compute initial # of spaces DEC @MNUM+1 Decrecment for 0 origin CLR @MNUM Clear high byte of double DIV 14,@MNUM TABs are 14 spaces apart INC @MNUM Compute next TAB-stop MUL 14,@MNUM and actual position CH @MNUM+1,@RECLEN Within this record BR PRCOL INC @MNUM+1 Convert to real position XML IO Fill spaces to new location BYTE FILSPC BR PRSEM Outside current record * The ":" (colon) separator is used to output the current * record, and proceed to position 1 of the next record. PRCOL CALL OUTREC Output the current record * The ";" (semi-colon) generates the null string. Since all * print items should be separated by a separator, this one * has been introduced to separate without moving to another * position. Notice that all separators join up here. PRSEM XML PGMCHR Skip the separator CALL CHKEND Exit on end of line BR CONPRT Continue if not end of line PRSMZ1 CZ @DSRFLG For screen output continue BS PREXIT CLOG >08,@PABPTR Check SIZE clause BS PREXIT CALL OUTREC Output current record (blank ST @CCPADR+1,@CCPPTR Compute correct value for CCP SUB >E1,@CCPPTR Subtract current screen base BR PREXIT and exit form this command * End of line exit routine for PRINT statement EOLEX CZ @DSRFLG I/O - remove blocks if BS G83A1 CLOG >04,@PABPTR " AT" clause unused BR G83A1 AND >E7,@PABPTR remove flag 3 (SIZE used) G83A1 CALL OUTREC Output pending record * Continue here if record remains pending PREXIT CZ @DSRFLG Regular file/device I/O BR G83B1 DEC @CCPPTR Back to actual offset ST @CCPPTR,V@OFS(@PABPTR) Save for next statement XML CONT Continue with next statement * End external I/O handling * Reset of code is for internal I/O handling (VDP) G83B1 CLOG >04,@PABPTR Is not used BR G83BB ST @CCPPTR,@XPT Save current value of pointer INCT @XPT CCPPTR: 1-28 G83BB CLOG >02,@PABPTR Used BEEP clause BS G83C3 CALL TONE1 ---------- BEEP ------------ G83C3 XML CONT Continue in PARSE routine * TSTINT - test for INTERAL type files, set COND if file * is NOT INTERNAL TSTINT CZ @DSRFLG Couldn't possibly be INTERNAL BR RTC CLOG >08,V@FLG(@PABPTR) Set COND according to bit 3 RTNC Return without changing COND ********* PRINT / DISPLAY USING SECTION ******************* * Arrive here after the keyword "USING" has been rejected. USING XML SPEED BYTE SYNCHK * Get first character of format BYTE USINGZ * after (double) checking USIN CEQ LNZ,@CHAT Pick up the line number BR G8430 XML PGMCHR Get high address ST @CHAT,@FAC XML PGMCHR and low address ST @CHAT,@FAC1 XML PGMCHR get next program character DST @EXTRAM,@FAC2 in SEETWO : EXTRAM value w * changed XML SPEED BYTE SEETWO * Find the line # in the progr DEX @EXTRAM,@FAC2 result in SEETWO is in EXTRA * and restore EXTRAM value BR USNGZ1 has to match exactly DINCT @FAC2 Move up to the pointer field DST @DATA,@FAC8 Save DATA pointer for READ fi CALL GRSUB2 Read 2 bytes of data from ERA BYTE FAC2 * @FAC2 : Source address on ERA DST @EEE1,@DATA @EEE1 : Destination addr. on * Put it in @DATA ST IMAGEZ,@FAC2 Search for an IMAGE token CALL SEARCH at beginning of an statement BS USNGZ1 Error if not found on this li CALL GETGFL Get first part of format stri CALL CHKSTR Prepare data for string assig DST @FAC6,@BYTES Copy actual string length in DST @FAC8,@DATA Restore original DATA pointer CALL CTSTR Create a temporary string DCZ @FAC6 BS G842E CZ @RAMTOP Data from RAM BR G8423 MOVE @FAC6,V*TEMP5,V*SREF BR G842E G8423 DST @FAC6,@FFF1 FFF1 : byte count DST @TEMP5,@DDD1 DDD1 : source address in ERAM DST @SREF,@EEE1 EEE1 : destination address on XML GVWITE Write data from ERAM to VDP G842E BR G8438 G8430 XML PARSE Parse up to the ending ":" BYTE COLONZ CEQ STRVAL,@FAC2 * IMAGE ERROR * BR USNGZ1 G8438 CEQ COLONZ,@CHAT Probably no variable list BS G8448 CALL CHKEND We better check that through BR ERRSYN something sneaky sneaked in CZ @FAC7 End of line exit BS EOLEX BR G8463 Look for format item G8448 CZ @FAC7 Exclude null strings BS USNGZ1 DST @FAC4,@ARG Get start address for string ST @FAC7,@ARG2 Get format string length USNGZ0 CEQ >23,V*ARG Found no format item yet BS G8460 DINC @ARG Try next address DEC @ARG2 Update address BR USNGZ0 Try up to the end of the stri USNGZ1 BR ERRIM * IMAGE ERROR * Now we're sure that we have at least one legal format ite * (anything with a "#" in it) G8460 ST COMMAZ,@CHAT Fake comma seperator for prin G8463 XML VPUSH Current string might be tempo DST @FAC6,@BYTES Create a workstring for outpu INC @BYTES+1 Create space for end of strin CARRY String would be too long BS USNGZ1 XML GETSTR Length whold equal format str DST @SREF,@CURLIN Create a temporary string DADD @FAC6,@SREF Compute last position in stri CLR V*SREF Set end of string indicator USNGZ3 DST V@4(@VSPTR),@FAC4 Update FAC4 area in case garb MOVE @FAC6,V*FAC4,V*CURLIN Copy format DST @CURLIN,@FAC4 Complete preps for VPUSH DST >001C,@FAC SREF = >001C DINC @FAC6 Include 0 in string length XML VPUSH Make the string temporary DST V@4(@VSPTR),@CURLIN Update current line pointer USNGZ4 CEQ >23,V*CURLIN Try to locate the next format BS G84C3 CZ V*CURLIN Not end of string yet BS G84A2 DINC @CURLIN Update pointer if not found BR USNGZ4 and continue searching G84A2 CEQ COMMAZ,@CHAT Stop on last variable BR USNGZ9 XML VPOP Restore original workstring d ST @FAC7,@BYTES Pring the current format stri DEC @BYTES Don't count the last "0" ST 1,@MNUM+1 Indicate direct output withou CALL CHKRZ0 Copy string to output record CALL OUTREC Also output current record * FAC still contains the right data, however it is easier j * to copy the original string again. DST @FAC4,@CURLIN Reconstruct CRULIN XML VPOP Copy original string info XML VPUSH Without actually removing it DSUB @FAC6,@CURLIN Reconstruct start address BR USNGZ3 Continue for the next variabl G84C3 DCEQ V@4(@VSPTR),@CURLIN Avoid "#" as count BS USNZ42 DDEC @CURLIN Backup to the sign CEQ >2E,V*CURLIN Used ".#####" BR G84DB DCEQ V@4(@VSPTR),@CURLIN BS USNZ42 DDEC @CURLIN Avoid checking count bit G84DB CEQ >2D,V*CURLIN Check for minus BS USNZ42 CEQ >2B,V*CURLIN Check for plus BS USNZ42 DINC @CURLIN It's neither, so we undo * Check for availability of variables USNZ42 CEQ COMMAZ,@CHAT Exit if no more pt item BR USNGZ9 XML PGMCHR Get next expression DSUB V@4(@VSPTR),@CURLIN Make CURLIN offset for * garbage collection XML PARSE Parse up to ";" or "," BYTE SEMICZ DADD V@4(@VSPTR),@CURLIN Reconstruct new CLN after * garbage collection DCLR @FAC8 Start with clean sheet for co DCLR @FAC11 CLR @FAC13 DST @CURLIN,@VAR4 Now start checking process CEQ >2E,V*CURLIN BS USNGZ5 CEQ >23,V*CURLIN Has to be "+" or "-" BS G8527 CEQ >2D,V*CURLIN BR G851B OR >02,@FAC11 Set explict sign flag for CNS G851B CEQ >2B,V*CURLIN BR G8527 OR >02,@FAC11 Set explict sign flag for CNS OR >04,@FAC11 Set positive sign flag for CN G8527 CALL ACCNM Accept first character plus " ST @FAC9,@FAC12 Set up FAC12 for CNS CEQ >2E,V*VAR4 Found decimal point BR G8540 USNGZ5 CLR @FAC9 Prepare for use as counter of * of # sign after decimal poin CALL ACCNM Accept some more "#"'s ST @FAC9,@FAC13 Set up FAC13 for CNS ADD @FAC12,@FAC9 FAC9 now contains the total n * of "#" sign, decimal point a * maybe a sign bit DEC @FAC9 Exclude the decimal point G8540 DCEQ >5E5E,V*VAR4 Attempt to decode ^^ BR USNZ55 DINCT @VAR4 Update address DCEQ >5E5E,V*VAR4 BR G8562 DINCT @VAR4 Update address OR >08,@FAC11 Set E-format bit for CNS CEQ >5E,V*VAR4 BR USNZ55 DINC @VAR4 Update end address OR >10,@FAC11 Set extended E-format bit for BR USNZ55 G8562 DDECT @VAR4 Correct for previous errors * At this point, CURLIN is pointing at the first item of th * format, VAR4 is pointing at the character following the i USNZ55 CHE >64,@FAC2 Detected numerical argument BS G8596 CLOG >02,@FAC11 Exclude the sign count BS G8570 DEC @FAC9 FAC9 : Number of significant G8570 CLOG >08,@FAC11 If E-format is used BS G857C CGT >0A,@FAC9 More than 10 significant digi BS ERRIM BR G8581 G857C CGT 14,@FAC9 More than 14 significant digi BS ERRIM G8581 OR >01,@FAC11 Set fixed format output it fo XML XCNS 1 Convert number to fixed forma * FAC11 points to the beginning of the string after supress * leading 0's, FAC12 contains the length of the string ST @FAC11,@FAC13 FAC13 now point to beginning * the string CLR @FAC11 Clear high byte MOVE @FAC11,*FAC13,V*CURLIN Copy the result string f * temporary DST @VAR4,@CURLIN Move pointer behind print fie BR USNGZ4 Continue after printing G8596 DST @VAR4,@FAC10 Compute total length DSUB @CURLIN,@FAC10 CH @FAC11,@FAC7 String exceeds limits BR G85B1 ST >2A,@VAR0 Prepare a "*****.." string G85A4 ST @VAR0,V*CURLIN Fill the remainder of field DINC @CURLIN Up to the end USNZ67 DCEQ @VAR4,@CURLIN Which is stored in VAR4 BR G85A4 BR USNGZ4 G85B1 DCZ @FAC6 BS USNZ68 MOVE @FAC6,V*FAC4,V*CURLIN Copy result string DADD @FAC6,@CURLIN And update address in string USNZ68 ST SPACE,@VAR0 Fill remainder with spaces BR USNZ67 USNGZ9 XML VPOP Temporary string back out ST @CURLIN+1,@BYTES Output up to the current * position SUB @FAC5,@BYTES Create one byte result BS USNZ95 Avoid empty strings ST 1,@MNUM+1 Prevent skip if field too sma CALL CHKRZ0 Preform all nomal I/O stuff USNZ95 XML VPOP Remove source format string CALL CHKEND Check for end of line exit BS EOLEX Take end of line exit XML SPEED BYTE SYNCHK * Then it HAS to be a ";" BYTE SEMICZ CALL CHKEND Now - must be EOS BS PRSMZ1 Supressed end of record, make * it a pending record BR ERRSYN SYNTAX ERROR * Collect string of "#"'s ACCNM INC @FAC9 Update item count DINC @VAR4 and item address CEQ >23,V*VAR4 Decode as many "#"'s as * possible BS ACCNM RTN Return from duty *********************************************************** * INPUT ROUTINE * First check for file or screen I/O. If file I/O then chec * for pending output and print that. If screen I/O then * check for input prompt: * Next collect the INPUT variable list on the V-stack. Get * enough input form either file or keyboard, and compare * types with entries on V-stack. After verification and * approval, assign the values. *********************************************************** INPUT CALL INITKB Assume keyboard INPUT CEQ NUMBEZ,@CHAT Might be #0 or #1-255 BR G875A CALL CHKFN Check for default #0 DCZ @FAC If luno #0 BR G860B DST @PGMPTR,@INPUTP Save PGMPTR for "try again" DINC @INPUTP Pass the ":" for the * "prompt" code handler * later, (using #0 will not * take care the prompt in * INPUT) CALL INPUZ2 #0 is equivalent to no # BR INPZ2 G860B CALL INSU1 Get info about file * INTERNAL files get special treatment CLOG >08,V@FLG(@PABPTR) ; INTERNAL file BS G86AD CZ V@OFS(@PABPTR) Fresh start BR G861E INTRZ0 CALL IOCLZ1 Get a new record through * the DSR G861E ST V@OFS(@PABPTR),@VARA+1 Regain possible offset CLR @VARA Make that a two byte constant DST V@BUF(@PABPTR),@TEMP5 Get first address DADD @VARA,@TEMP5 Compute actual address * within record INTRZ1 CALL BUG01 Get the symbol table entry * Above call fixes bug, of the given variable XML VPUSH And save it on the stack DCLR @BYTES Assume no data available CHE V@CNT(@PABPTR),@VARA+1 Pick up data BS G8643 ST V*TEMP5,@BYTES+1 Length byte first DINC @TEMP5 Update both actual address INC @VARA+1 and offset G8643 CEQ >65,@FAC2 Has to be string variable BR G8650 DST @BYTES,@FAC6 Set length of string CALL CTMPST Create temporary string BR G867E G8650 CEQ >08,@BYTES+1 * FILE ERROR BR ERRFE MOVE @BYTES,V*TEMP5,@FAC Copy value DCZ @FAC Watch out for non-scaled stuf BS G867C ST FAC7,@ARG Test for legal numeric G8661 CH 99,*ARG * FILE ERROR BS ERRFE DEC @ARG Next digit for test CEQ FAC1,@ARG BR G8661 DST @FAC,@ARG Copy in ARG for some testing DABS @ARG Be sure we're positive * If first byte after expon. byte=0 : incorrect * normalization has occured : FILE ERROR * Or >99 : illegal numeric : FILE ERROR DEC @ARG1 0 would cause underflow here CH 98,@ARG1 BS ERRFE BR G867E G867C DCLR @FAC2 Be sure FAC2 = 0 (no strings) G867E DADD @BYTES,@TEMP5 Update address and ADD @BYTES+1,@VARA+1 offset again XML ASSGNV Assign value to variable CLR V@OFS(@PABPTR) Undo allocated offsets CEQ COMMAZ,@CHAT BR G86AB XML PGMCHR Get next text character CALL CHKEND Check for end of statement BS INTRZ2 OK, EOS is fine CHE V@CNT(@PABPTR),@VARA+1 BS INTRZ0 BR INTRZ1 Still something left INTRZ2 CHE V@CNT(@PABPTR),@VARA+1 BS G86AB ST @VARA+1,V@OFS(@PABPTR) Save value of offset G86AB XML CONT And CONTINUE G86AD CALL GETVAR Collect variable list on stac DST @STADDR,@CURLIN Save it in temp DST CRNBUF,@RAMPTR Initialize crunch buffer poin CLR @RECLEN Initialize field counter ST CZREAD,V@COD(@PABPTR) Select READ operation CZ V@OFS(@PABPTR) BR INPZ31 BR INPZ3 Adjust for used record usage G86C6 ST COMMAZ,V@-1(@RAMPTR) Fake legal separator INPZ3 CALL IOCLZ1 Get next input record CLR V@OFS(@PABPTR) Reset offset within record CALL RECENT ST V@CNT(@PABPTR),@VARA Get record length G86DB CZ @VARA BS INPZ31 ADD OFFSET,V*VARW Add video offset for normal DINC @VARW Screen-type crunch - proceed DEC @VARA for entire record BR G86DB INPZ31 CALL RECENT Compute actual record entry ST V@CNT(@PABPTR),@VARA+1 Compute end of record CLR @VARA Make that a double byte DADD V@BUF(@PABPTR),@VARA Add buffer start addr DDEC @VARA Point to last position in rec CLR @VAR6 Assume no values input XML CRUNCH Scan data fields as in DATA s BYTE 1 * Indicate input stmt crunch DCZ @ERRCOD If some crunch error BR ERRINP INC @VAR6 Get correct # of fields (one ADD @VAR6,@RECLEN Update # of fields up to now CHE @VAR5,@RECLEN OK, THAT'S ENOUGH!!!! BR G86C6 DDECT @PGMPTR Backup program pointer XML PGMCHR Re-inspect last token before CALL RECENT Precompute record entry CLR V@OFS(@PABPTR) Assume no pending record CEQ COMMAZ,@CHAT Make record pending BR G8752 CEQ @VAR5,@RECLEN Enough left pending BS G8752 SUB @VAR5,@RECLEN Compute remaining # of fields SUB @RECLEN,@VAR6 # of fields used in last reco INPZ32 CEQ >82,V*VARW +OFFSET BR G873A Skip quoted strings G872E DINC @VARW CEQ >82,V*VARW +OFFSET BR G872E DINC @VARW BR INPZ32 Search for Nth data item G873A DINC @VARW Update pointer CEQ >8C,V@-1(@VARW) * ","+OFFSET = >8C BR G873A DEC @VAR6 Commas denote end of field BR INPZ32 Continue until done DSUB V@BUF(@PABPTR),@VARW Compute current offset ST @VARW+1,V@OFS(@PABPTR) Store for next round G8752 ST @VAR5,@VAR6 Copy # of variables for check DST @CURLIN,@STADDR Restore from temp BR G8786 G875A CALL INITKB Initialize some variables for DST @PGMPTR,@INPUTP Save for "try agian" case DST @CCPPTR,@CPTEMP Save CCPPTR, RECLEN for "try * Entry point for "try again" case INPZ33 CALL INSUB1 Put out prompt INPZ2 CALL GETVAR Get variable list on V-stack INPUZ3 CALL INSUB2 Read from the screen CLR @VAR6 Assume no values input XML CRUNCH Crunch the input line BYTE 1 * Indicate input stmt scan DST @CURLIN,@STADDR Restore from temp DCZ @ERRCOD If got some crunch error BR WRNINP XML SCROLL Scroll up after crunching ST 3,@XPT Reset XPT too - pending recor INC @VAR6 # fields = # of commas + 1 CEQ @VAR6,@VAR5 # of variables wrong BR WRNINP * Once we're here, all information should be availiable * After type verification for input and variables, push * all value entries on the V-stack. * VAR6 = VAR5 = number of variables G8786 DST @DATA,@CURLIN Save current DATA pointer DST CRNBUF,@DATA Get crunch entry DST @VAR4,@MNUM Get entry in V-stack before P INPUZ4 DADD 8,@MNUM Point to first symbol table e DST V*MNUM,@CCPPTR Get immedediate result CALL GETRAM Get value descriptor from RAM CLOG >80,V*CCPPTR Numerical value BR G87CF CALL CHKNUM Check entered value against n BR INPUZ5 Found error CZ @DSRFLG Do not check overflow in file * supply machine infinity with * appropriate sign and continu BS INPUZ6 CZ V@CSNTP1 Watch out for overflow in scr BS INPUZ6 DST @CURLIN,@DATA Restore DATA pointer BR WRZZ5 Ask for input re-enter INPUZ5 CZ @DSRFLG FILE I/O IS FATAL BS ERRINP DST @CURLIN,@DATA Restore DATA pointer on error WRNINP CALL WARNZZ Go here for simple warnings t BYTE 32 * INPUT ERROR - TRY AGAIN WRZZ5 CALL SCRZ Scroll the screen and reset C DST @INPUTP,@PGMPTR Restore ptr to "prompt" if an DST @CPTEMP,@CCPPTR Restore CCPPTR, RECLEN, for t DST @VAR4,@VSPTR Restore original stack ptr BR INPZ33 G87CF CALL CHKSTR Check string input BS INPUZ5 ERROR ... CHECK I/O TYPE INPUZ6 CALL GETRAM Get separation character (RAM CEQ COMMAZ,@VAR0+1 BS G87E6 DEC @VAR6 Has to be end of data BR INPUZ5 If not ... ERROR CZ @VAR0+1 BR INPUZ5 BR G87EA G87E6 DEC @VAR6 Count number of value entries BR INPUZ4 Continue * Assign cycle - assign values to variables because it resc * the program line, this code can not be udes for inperativ * statements , since the crunch buffer get's destroyed on * input. The rescan is necessary because subscripts should * evaluated AFTER all previous values have been assigned. i * INPUT I,A(I) with values 2,3 * Should assign value 3 to A(2) !!!!!!!!! * No error-checking is done here, since types are already * validated. We might get subscripts out of range though!!! G87EA DST CRNBUF,@DATA Prepare for input rescan DST @STADDR,@PGMPTR Restore token pointer for res DDEC @PGMPTR Backup on token DST @VAR4,@VSPTR Restore original stack pointe INPZ65 XML PGMCHR Get next program characters CALL CHKEND Might have , before EOS BS INPUZ7 CALL BUG01 Rescan variable name * Above call fixes bug. Get correct entry for arrays XML VPUSH Save on stack for ASSGNV CALL GETRAM Get first token of input valu CEQ STRVAL,@FAC2 Numerical case BS G880F CALL CHKNUM Check for numerical value BS INPZ67 COND should be set (valid num G880F CALL CHKSTR Get the correct string value DST @FAC6,@BYTES Length for temporary string CALL CTMPST Create temporary string INPZ67 XML ASSGNV Assign value to variable CALL GETRAM Skip separator (already check CALL CHKEND Check for end to statement BR INPZ65 Found it INPUZ7 DST @CURLIN,@DATA Restore DATA pointer XML CONT Contiue in PARSE RECENT ST V@OFS(@PABPTR),@VARW+1 Get record offset CLR @VARW Double byte value required DADD V@BUF(@PABPTR),@VARW Got it RTN AND NOW, THE END IS NEAR... CHKRM DCH SCRNBS+29,@CCPADR Not enough room for "?" BR G8840 SCRZ XML SCROLL Scroll one line for "?" DST SCRNBS+2,@CCPADR and update CCPADR accordingl G8840 RTN *********************************************************** * LINPUT ROUTINE * If file-I/O then * Get file number and check it * Internal file not allowed * End if * Get variable info * Must be string variable * If file I/O then * If no-partial-record of REC clause included * Read new record * End if * Set up copy pointers * Else * Call readline to read from keyboard * Copy to crunch buffer adjustin g for screen offset * End if * Get string of proper length * Move data into string * Assign string * Done. *********************************************************** LINPUT CALL INITKB Assume input from keyboard CEQ NUMBEZ,@CHAT If "#" - then device BR G885C CALL CHKFN Check for default = 0 DCZ @FAC #0 is assumed BS LINP10 CALL INSU1 Parse the device # CLOG >08,V@FLG(@PABPTR) BR ERRFE BR LINP10 G885C CALL INSUB1 Handle possible prompt LINP10 DST @VSPTR,@VAR4 Save original V-pointer * incase BREAK in READLN CALL BUG01 Get info about the symbol * Above call fixes bug. Get value pointer and type CEQ STRVAL,@FAC2 Must be string BR ERRMUV XML VPUSH CZ @DSRFLG If device I/O BR G88AF CZ V@OFS(@PABPTR) If new record BR G887B CALL IOCLZ1 Read the record BR G8893 G887B ST V@CNT(@PABPTR),@BYTES Get length of record DST V@BUF(@PABPTR),@TEMP5 Get address of buffer G8885 CZ @BYTES While characters in buffer BS G8893 SUB OFFSET,V*TEMP5 Remove INPUT's offset DINC @TEMP5 Increment pointer DEC @BYTES Decrement count BR G8885 Drop out directly when done G8893 CLR @TEMP5 Need a word value ST V@OFS(@PABPTR),@TEMP5+1 Restore value CLR @BYTES Need a word value ST V@CNT(@PABPTR),@BYTES+1 Get the length DSUB @TEMP5,@BYTES Calcualte length DADD V@BUF(@PABPTR),@TEMP5 Current buffer address CLR V@OFS(@PABPTR) Read next record next time BR G88E1 Else if keyboard input G88AF CALL INSUB2 Clear line and call READLN DCLR @BYTES Initialize byte counter DST @RAMPTR,@TEMP5 Initialize "crunch" pointer CEQ SPACE+OFFSET,V*VARA If space BR G88BF DDEC @VARA Don't include space on end G88BF DCGT @VARA,@VARW While not at end BS G88DC ST V*VARW,@VAR0 Get the character CEQ EDGECH,@VAR0 If not at edge character BS G88D8 SUB OFFSET,@VAR0 Subtract screen offset ST @VAR0,V*RAMPTR And put into crunch buffer DINC @BYTES Count it DINC @RAMPTR And update "crunch" pointer G88D8 DINC @VARW Update input pointer BR G88BF G88DC XML SCROLL Scroll the screen ST 3,@XPT Initialize x-pointer G88E1 CALL CTMPST Create temporary string XML ASSGNV Assign the value to it XML CONT And continue execution * Get file number and info about the file INSU1 CALL CHKCON Check & convert & search BR ERRFE Give error if required * INPUT allowed for input and update modes CLOG >02,V@FLG(@PABPTR) BR ERRFE CALL OUTEOF Output pending PRINT stuff ST CZREAD,V@COD(@PABPTR) Ensure read operation CALL PARREC Parse REC clause XML SPEED Must be at a BYTE SYNCHK * colon else BYTE COLONZ * its and error CLR @DSRFLG Clear keyboard input flag RTN * Parse and put out input prompt INSUB1 DST @PGMPTR,@STADDR Save pointer for prompt check DDEC @STADDR Backup to previous token * Go into a tight loop G890B CALL NXTCHR Get next program character BS INPZ37 Detected end of statement CEQ COLONZ,@CHAT Stop if we find a colon BR G890B DST @STADDR,@PGMPTR Backup for actual prompt scan XML PGMCHR Jump into 1st char of prompt XML PARSE And try to decode string expr BYTE COLONZ CEQ STRVAL,@FAC2 Number prompt illegal BR ERRSNM CALL OSTRNG Output the given prompt BR INPZ39 Exit without prompt backup INPZ37 DST @STADDR,@PGMPTR Backup to beginning of line ST COLONZ,@CHAT Fake prompt with ":" INPUZ2 CALL CHKRM Check for room for ? ST >9F,V*CCPADR Display ? DINCT @CCPADR Count it too INPZ39 XML SPEED Must be at a BYTE SYNCHK * colon else BYTE COLONZ * its an error RTN * Issue 'BEEP' and call read line to read form screen INSUB2 CALL CHKRM Check for room for answer DST @CCPADR,@VARW Copy current cursor position G8941 ST >80,V*CCPADR Clear the remainder DINC @CCPADR of the current line DCHE >02FE,@CCPADR Stop if we're there BR G8941 DST >7F7F,V@>02FE Replace edgechars CZ @PRTNFN If previous tone finished BR G895A CALL TONE1 ---------- BEEP ------------- G895A DEX @VAR4,@VSPTR Don't destroy V-stack on BREA CALL READLN Input a line from the keyboar DEX @VAR4,@VSPTR Restore V-stack pointer DST @STADDR,@CURLIN Save in a temp DST CRNBUF,@RAMPTR Init crunch buffer pointer RTN *********************************************************** * ACCEPT STATEMENT * Accept input anywhere on the screen. The total number of * input variables is limited to one. On an ACCEPT AT( , ), * the maximum number that can be accepted is up to the righ * margin!!!! If SIZE() is used, the maximum number is * limited to the given SIZE, or to the number of characters * remaining on the line, whichever is the lesser. *********************************************************** * RXB PATCH TO FIX ACCEPT USED IN EDIT MODE * ACCEPT CLR @ACCTRY Clear "try again" flag ACCEPT B ACCPMM ACCEP2 CALL DISACC Use common code for DISPLAY/A BS ERRSYN COND set means end of statem ST >FF,@ARG7 Assume we don't have VALIDATE ************ VALIDATE OPTION HANDLING ********************* CEQ VALIDZ,@CHAT Detected VALIDATE option BR G89FD XML PGMCHR Next character should start o CEQ LPARZ,@CHAT "* SYNTAX ERROR *" BR ERRSYN OR >40,@PABPTR Indicate usage of validate cl DST 1,@VARA Use VARA as length of option DCLR @VARW VARW= options used, VARW+1=#0 * stack entries for strings G898B XML PGMCHR Skip separator token CHE NUMERZ,@CHAT Could be valid option BR G89AA CHE UALPHZ+1,@CHAT It is .... BS G89AA ST 1,@ARG Select bit 0 as number option SUB NUMERZ,@CHAT Create correct offset BS SETVW Skip the shift stat. SLL @CHAT,@ARG Then select whatever option w SETVW OR @ARG,@VARW Remember options in VARW * stack entries for strings XML PGMCHR Get next token B VLIDZ0 Must use a long branch here G89AA XML PARSE Try to decode a string expres BYTE RPARZ CEQ STRVAL,@FAC2 String-number mismatch BR ERRSNM CZ @FAC7 Only count non-null strings BS VLIDZ0 ADD @FAC7,@VARA+1 Now watch out for overflow CARRY Sting truncated BR G89C0 CALL ERRZZ * STRING TRUNCATED ERROR * BYTE 19 G89C0 XML VPUSH Push the result for future re INC @VARW+1 Count number of entries on st VLIDZ0 CEQ COMMAZ,@CHAT Evaluate all fields BS G898B XML SPEED BYTE SYNCHK * Check for ")" on end BYTE RPARZ * If not, "* SYNTAX ERROR *" CALL DISPZ1 Try to evaluate further optio BS ERRSYN Premature end of statement DST @VARA,@BYTES Allocate string for character XML GETSTR DST @SREF,@ARG Get start of allocated string ST @VARW,V*ARG Get start of allocated string DINC @ARG Leave room form standard opti G89E0 CZ @VARW+1 Copy all available informatio BS G89F3 XML VPOP Regain stack-entry MOVE @FAC6,V*FAC4,V*ARG Copy string DADD @FAC6,@ARG Update destination address DEC @VARW+1 Count # of stack entries BR G89E0 G89F3 DST @SREF,V@VALIDP Copy start address of string DST @VARA,@VALIDL and total string length CLR @ARG7 Indicate VALIDATE usage of RE G89FD DST @CCPADR,@VARW Save start address of the fie DST @VARW,@VARA Set default highest address u DST @CCPADR,@ARG2 Select absolute highest usabl DADD 290,@ARG2 290=2+32*9 maximum of 254 cha CH >FC,@VARA+1 Start at the end of line BR G8A13 DADD 4,@ARG2 G8A13 CZ @PABPTR We used some options like AT, BS G8A66 XML SPEED BYTE SYNCHK * Should always end on ":" BYTE COLONZ CLOG >02,@PABPTR Used BEEP clause BS G8A23 CALL TONE1 Wake up the user G8A23 CLOG >04,@PABPTR Used AT option, SIZE!!! BS G8A35 CLOG >08,@PABPTR Use defualt SIZE option BR G8A33 ST VWIDTH,@PABPTR+1 Limit current record length CALL SIZE1 G8A33 BR ACCPZ1 G8A35 CLOG >08,@PABPTR SIZE option used somewhere BS G8A66 * We're sure now that SIZE has been used WITHOUT the AT * option, this means that we should set XPT to point behind * the SIZE field. This can be done by adding the record * length to the current screen base address and the line's * screen base address ST @CCPADR+1,@XPT Start of with current address ADD @RECLEN,@XPT Add in the current record len SUB >DF,@XPT And subtract the lower base a * Also adjust for edge characte ST @XPT,@SIZXPT Save it for "try again" case * in WARNING, XPT gets changed ACCPZ1 DST @CCPADR,@SIZCCP Save for "try again" case ST @RECLEN,@SIZREC Save for "try again" case *********************************************************** * ENTRY POINT FOR "TRY AGAIN" CASE WHEN SIZE OR ACCEPT USED *********************************************************** ACCPZ9 CLOG >80,@PABPTR Blank current field BR G8A58 ST SPACE+OFFSET,V*CCPADR G8A58 DINC @CCPADR Update screen address DEC @RECLEN Reduce count, always at least BR ACCPZ9 Loop until at end of field DDEC @CCPADR Fix end of field for maximum DST @CCPADR,@VARA Set highest location availabl DST @VARA,@ARG2 Also highest location availab * OK all set to go G8A66 CEQ 1,@ACCTRY Skip if in "try again" BS ACCPZ7 DST @VSPTR,@VAR4 Save first entry in V-stack CALL BUG01 Collect the symbol designator * Above call fixes bug. Take care of arrays too XML VPUSH Save symbol table entry ACCPZ7 DST @VARW,@ACCVRW Save for trying again case DST @VARA,@ACCVRA Save for trying again case *********************************************************** * ENTRY POINT FOR "TRY AGAIN" WHEN NEITHER SIZE OR ACCEPT I *********************************************************** * In case a CALL CLEAR or ERASE ALL or CALL HCHAR has just * processed, EDGE CHARS, are gone at the bottom line ACCPZ5 CLOG >0C,@PABPTR If AT/SIZE used, maximum fiel BR AZ1 is line, so no need to worry * about it DST >7F7F,V@>02FE Put the EDGE CHAR back AZ1 DEX @VSPTR,@VAR4 Don't destroy V-stack on BREA CALL READL1 Ask for some input that can b * used DEX @VSPTR,@VAR4 Resote V-stack pointer * At this point, VARA contains the highest location used, * and VARW contains the string's start address ACCPZ2 DCEQ @VARW,@VARA Only non-empty string BS G8A9E DDEC @VARA Go to the next position CEQ SPACE+OFFSET,V*VARA BS ACCPZ2 DINC @VARA Back to the last space G8A9E XML VPOP Check the symbol designator i XML VPUSH a string or numeric variable CEQ >65,@FAC2 If numeric : empty string is BS G8AB2 DCEQ @VARA,@VARW If an empty string was entere BR G8AB2 CALL WARNZZ *** INPUT ERROR *** BYTE 32 BR ACCPZ8 G8AB2 DCLR @BYTES Compute length of input strin DST @VARW,@SREF Use SREF as temporary variabl G8AB7 DCEQ @VARA,@SREF BS G8AC8 CEQ EDGECH,V*SREF Exclude edge character BS G8AC4 DINC @BYTES G8AC4 DINC @SREF Decrement the counter BR G8AB7 G8AC8 CALL CTSTR0 Create a temporary string ACCPZ3 DCEQ @VARA,@VARW BS G8AEB CEQ EDGECH,V*VARW Skip the edge character BR G8ADC DADD 4,@VARW BR ACCPZ3 G8ADC ST V*VARW,V*SREF Copy the string SUB OFFSET,V*SREF Subtract the screen offset DINC @VARW Update pointers DINC @SREF BR ACCPZ3 Result can't be 0 G8AEB CEQ STRVAL,@FAC2 Numerical variable BS ACCPZ6 ST STRVAL,@FAC2 Create temp string CALL VALCD Use VAL code for translation BR ACCPZ6 No error - ok go on WRNSNM CALL WARNZZ Error BYTE 7 * STRING NUMBER MISMATCH ACCPZ8 CLOG >08,@PABPTR If SIZE is used BS G8B0A CLOG >04,@PABPTR Also AT is not used BR G8B0A ST @SIZXPT,@XPT Restore XPT : in WARNING XPT G8B0A DST @ACCVRW,@VARW Restore @VARA, @VARW DST @ACCVRA,@VARA ST 1,@ACCTRY Set the "try again" flag CLOG >08,@PABPTR If SIZE is not used BR G8B20 * IF ACCEPT ALSO NOT USED. GOTO "TRY AGAIN" FORM HERE CLOG >04,@PABPTR BS ACCPZ5 * IF "EITHER SIZE OR ACCEPT IS USED" THEN G8B20 DST @SIZCCP,@CCPADR Restore CCPADR ST @SIZREC,@RECLEN Restore RECLEN BR ACCPZ9 Go blanking the field and * "try again" ACCPZ6 XML ASSGNV Should be ok now CLOG >0C,@PABPTR Test usage of AT and/or SIZE BR ACCPZ4 At least one of the two used XML SCROLL Scroll the screen up ST 3,@XPT And reset XPT ACCPZ4 XML CONT *********************************************************** * READ STATEMENT * Assign DATA values to variables in READ-list one at a * time. Possibly search for new DATA statements if the * current DATA statement has been used. Be careful with * null entries...!!! *********************************************************** G8B38 XML PGMCHR Get character following "," READ CALL BUG01 Get pointers and correct entr * Above call fixes bug. also allow for array variabl XML VPUSH Push on Vstack for assignment CZ @DATA DATA ERROR BS ERRDAT CALL GETGFL Get next data item (RAM/GROM) CEQ STRVAL,@FAC2 BS G8B6B CEQ NUMZ,@VAR0+1 Not a numeric BR ERRSNM * string-number mismatch error CALL CHKSZ0 Build up string info DINC @FAC6 Force legal delimiter on end CALL LITS05 Copy numeric into string spac DST @SREF,@FAC12 Copy string start address DADD @FAC6,@SREF Compute end address of string DDEC @SREF Back up over delimiter CALL CONV1 Convert string to number DCEQ @SREF,V@CSNTMP WRONG!!!!!!! BR ERRDAT BR G8B73 G8B6B CALL CHKSTR Check string input BS ERRDAT Give error on error CALL LITS05 Allocate string in string spa G8B73 XML ASSGNV Assign variable CALL GETGFL Get next datum from DATA stmt CEQ COMMAZ,@VAR0+1 Has to be an end of DATA BS G8B8F CZ @VAR0+1 Check for end of data BR ERRDAT DDECT @LNBUF Pointer to line # of DATA stm CLR @DATA Assume the worst - no more DA DCEQ @STLN,@LNBUF BS G8B8F DDEC @LNBUF Next line's 1st token address CALL DATAST Get next DATA statement G8B8F CEQ COMMAZ,@CHAT Worry about junk in CONT BS G8B38 XML CONT * SRDATA-Search for DATA statements (DATA statement must * be the only statement on one line) * SEARCH-also used for searching IMAGE statement. SRDATA ST DATAZ,@FAC2 Search for a DATA token SEARCH DEX @DATA,@PGMPTR Exchange with normal PC EX @CHAT,@VAR0+1 Preserve current PGM characte CZ @PRGFLG If imperative statement BR G8BB3 CZ @RAMTOP With ERAM : text itself in ER BS G8BB3 ST >FF,@RAMFLG Fake RAMFLG in this case XML PGMCHR Get first character on the li CLR @RAMFLG Restore it back BR SRDAZ1 Skip that PGMCHR G8BB3 XML PGMCHR Get first character on the li SRDAZ1 CEQ @FAC2,@CHAT Search for specific token BS SRDAZ0 CEQ @VAR0,@VAR0 Set COND if no DATA found SRDAZ0 DEX @DATA,@PGMPTR Exchange won't affect the CON EX @CHAT,@VAR0+1 Situation ok RTNC Return to caller with COND *********************************************************** * OLD STATEMENT * A normal load: * Get a program from an external device to VDP and * reinitialize the program pointers. Also update the line * pointer table, since the memory size of the machine on * which the program was created doesn't have to be the * same as on the current system!!!! Then check if ERAM * existed, move it to ERAM if does exist (in relocated * from) * Load a sequential file: * When program is bigger than 13.5K and ERAM exists, * maximum-length record reads are preformed to read the * file and each record is copied into the ERAM as it is * read. *********************************************************** OLD CALL OLD1 Make OLD1 a subroutine for LO B TOPL15 Go back to top level OLD1 CALL GPNAME Get program name & reinitiali XML PGMCHR Check for EOL DST @PABPTR,@STADDR Compute memory start address DADD V@NLEN-1(@PABPTR),@STADDR Add PAB-name lengt DADD PABLEN-4,@STADDR and PAB length DST @HIVDP,V@RNM(@PABPTR) Compute # of availiable DSUB @STADDR,V@RNM(@PABPTR) DINC V@RNM(@PABPTR) Include current address DST @STADDR,V@BUF(@PABPTR) for copy start ST CZLOAD,V@COD(@PABPTR) Select LOAD I/O code CALL CDSR Call device service routine BR OLDZ3 Not a program file, may be a * sequential file * STADDR still points to the info bytes DST V@2(@STADDR),@MNUM First test checksum DXOR V@4(@STADDR),@MNUM which is a simple XOR DCEQ @MNUM,V*STADDR Try PROTECTION option BS G8C15 DNEG @MNUM DCEQ @MNUM,V*STADDR No-ERROR BR OLDER OR >80,@FLAG Yes, set LIST/EDIT PROTECTION BR G8C17 G8C15 CLR @FLAG Otherwise clear protection G8C17 DST V@2(@STADDR),@ENLN Copy new ENLN, DST V@4(@STADDR),@STLN STLN and DST V@6(@STADDR),@OLDTOP top of memory info DADD 8,@STADDR Point to program data DST @HIVDP,@NEWTOP Set up the new top CALL RELOCA Relocate according to @>8370 OLDZ5 CZ @RAMTOP ERAM present? BS LRTOPZ * No, go back to toplevel * Yes, move from VDP to ERAM * (in relocated form) ************ Move to the ERAM from CPUBAS first *********** DST @HIVDP,@VAR0 DSUB @STLN,@VAR0 DINC @VAR0 # of bytes to move DST @VAR0,@CCC @CCC : Byte count for VGWITE * RXB PATCH CODE FOR PMEMORY UPPER 24K * DST CPUBAS,@BBB @BBB : Destination addr on ER DST V@PMEM,@BBB @BBB : Destination addr on ER DST @BBB,@STADDR For later use as the base of * current program image in REL DST @STLN,@AAA @AAA : Source address on ERAM XML VGWITE Move from VDP to ERAM DST @HIVDP,@OLDTOP Set up old memory top DST @RAMTOP,@NEWTOP Set up new memory top CALL RELOCA Relocate the program image OLDZ7 DST @STLN,@RAMFRE Reset the RAMFRE on ERAM DDEC @RAMFRE BR LRTOPZ Go back to toplevel *********************************************************** * At this point : if ERAM not exist - ERROR off else open * sequential file to load program to ERAM through VDP RAM *********************************************************** OLDZ3 CZ @RAMTOP BS OLDER * Set up PAB for OPEN * File type : Sequential file, * Mode of operation : Input * Date type : internal * Record type : Variable length records * Logical record length : 254 maximum MOVE 9,G@PAB3,V@4(@PABPTR) Build the PAB DST @HIVDP,@FAC Compute the data buffer addre DSUB 253,@FAC DST @FAC,@AAA Save it for later use in VGWI DST @FAC,V@BUF(@PABPTR) CALL CDSR Call the device service routi BR ERRZ2B Return with ERROR indication * in COND * Start to read in file CALL IOCALL Read in the first record BYTE CZREAD * * Check the control information CEQ 10,V@CNT(@PABPTR) * 10 bytes contr info BR OLDER * >ABCD is the flag set at SAVE time indicating a program f DCEQ >ABCD,V*FAC BR OLDER DINCT @FAC DST V*FAC,@STLN Copy the new STLN DINCT @FAC DST V*FAC,@ENLN ENLN too DST @ENLN,@MNUM Test checksum DXOR @STLN,@MNUM DINCT @FAC DCEQ @MNUM,V*FAC Try PROTECTION option BS G8CBD DNEG @MNUM DCEQ @MNUM,V*FAC No, ERROR BR OLDER OR >80,@FLAG Yes, set LIST/EDIT PROTECTION BR G8CBF G8CBD CLR @FLAG Otherwise clear protection fl G8CBF DINCT @FAC * Check is there enough memory in ERAM DST V*FAC,@MNUM Get the old top of memory out DST @MNUM,@OLDTOP For later use in RELOCA DSUB @STLN,@MNUM DINC @MNUM Total # of bytes in program DST @MNUM,@CCC1 For later use as the byte cou * RXB PATCH CODE FOR PMEMORY UPPER 24K * DADD CPUBAS,@MNUM Add the total # of bytes to C DADD V@PMEM,@MNUM Add the total # of bytes to CPUBAS * Check if enough memory in ERAM GT Greater than >FFFF case BS OLDER DCH @RAMTOP,@MNUM Greater than >DFFF case BS OLDER * Move to ERAM starting from CPUBAS first, * then relocate according the new top of memory in ERAM * RXB PATCH CODE FOR PMEMORY UPPER 24K * OLZZ DST CPUBAS,@BBB @BBB : Destination addr in OLDZZ DST V@PMEM,@BBB @BBB : Destination addr in * ERAM FOR VGWITE DST @BBB,@STADDR For later use as base of the * current program image in ERAM RELOCA * DST HIVDP,@AAA @AAA has been set up before * DSUB 253,@AAA For copy start on VDP RAM * @CCC1 : Total # of bytes to move to ERAM, set up above CALL IOCALL Read in the second record BYTE CZREAD * Read in the file and each record * Should be a full (maximum length 254) record at this time * because program supposed to be bigger than 13.5K G8CE9 CEQ 254,V@CNT(@PABPTR) BR OLDER DST 254,@CCC @CCC : # of bytes to move XML VGWITE Move data from VDP to ERAM DADD 254,@BBB Update the destination addres * on ERAM DSUB 254,@CCC1 # of bytes left to move BS OLDZ9 No more bytes to move CALL IOCALL Read in the file and each rec BYTE CZREAD * Copied into ERAM as it is rea DCHE 254,@CCC1 Leave the last record alone BS G8CE9 * The record length should be the same as the # of bytes le * to move at this time CEQ @CCC1+1,V@CNT(@PABPTR) BR OLDER DST @CCC1,@CCC Set up byte count for the las XML VGWITE Move data from VDP to ERAM OLDZ9 CALL IOCALL Close the file BYTE CZCLOS DST @RAMTOP,@NEWTOP New top of memory * @OLDTOP : old top of memory, set up above * @STADDR : base of current program image in ERAM, set abo CALL RELOCA Relocate the program BR OLDZ7 Go to set the RAMFRE and back * toplevel * IV254 PAB3 BYTE >00,>1C,>00,>00,>FE,>00,>00,>00,OFFSET * OLD error exit code, don't kill machine OLDER CALL INITPG Initialize program space BR ERRZ2 And take error exit LRTOPZ CALL KILSYM Release string space/symbol t RTN *********************************************************** * RELOCATE THE PROGRAM IMAGE ACCORDING TO THE NEW TOP OF * MEMORY: * STLN : old STLN * ENLN : old ENLN * V@OLDTOP : old top of memory * V@NEWTOP : new top of memory * @STADDR : current base for the old image *********************************************************** RELOCA DST @PABPTR,@SIZCCP Save in temp. DST @OLDTOP,@MNUM Get the old top of memory DST @NEWTOP,@PABPTR Get the new top of memory DSUB @MNUM,@ENLN Compute ENLN relative to top DSUB @MNUM,@STLN Compute STLN relative to top DSUB @STLN,@STADDR Highest memory address used DCLR @MNUM Total # of bytes to be moved DSUB @STLN,@MNUM STLN = -(# bytes -1) DINC @MNUM Take care of that one DADD @PABPTR,@ENLN Compute new address of ENLN DADD @PABPTR,@STLN and STLN * @PABPTR : destination address, @STADDR : source address DST @MNUM,@ARG @ARG : byte count DST @STADDR,@VAR0 @VAR0 : source addr for MVDN DST @CCPPTR,@VAR5 Save in temp (CCPPTR, VARY2 E DST @PABPTR,@VARY2 @VARY2 : destination addr for DCEQ @RAMTOP,@NEWTOP Relocate the program BR G8D6F in ERAM XML MVDN Move from lower memory to hig * memory one byte at a time BR G8D7E G8D6F DCLR @SIZREC Clear a temporary variable DEX @RAMTOP,@SIZREC Save the RAMTOP, also fake as * if ERAM not exist for MVDN in thi XML MVDN Move in VDP DEX @RAMTOP,@SIZREC Restore RAMTOP G8D7E DST @VAR5,@CCPPTR Restore back * Update line # links according to new size DST @OLDTOP,@MNUM Old memory top DSUB @NEWTOP,@MNUM Stop if sizes are same BS RELOZ1 DST @STLN,@STADDR Start relocation at STLN OLDZ2 DCHE @STADDR,@ENLN and continue up to ENLN BR RELOZ1 DINCT @STADDR Skip the line # CEQ @RAMTOP,@NEWTOP If in ERAM BR G8DAB CALL GRSUB2 Read the link out BYTE STADDR DSUB @MNUM,@EEE1 Update CALL GWSUB Write it back BYTE >0A,>58,>02 * STADDR,EEE1,2 BR G8DAF G8DAB DSUB @MNUM,V*STADDR Upadate the link G8DAF DINCT @STADDR Skip the link, next line # BR OLDZ2 And continue until done RELOZ1 DST @SIZCCP,@PABPTR Restore from temp RTN *********************************************************** * SAVE STATEMENT * SAVE "NAME", MERGE : Save in crunched form in program * into a file one line at at time with the line number. * File opened with sequential accessed, variable-length * records (161 max), display type & output mode, move one * line number and one in text to the crunch buffer then * write to the file one line at a time. * A normal SAVE : When ERAM not exist or the size of the * program and line number table in ERAM can fit in VDP * (can be moved into VDP from ERAM once), then the save * statement saves a program image to an external device, * including all the information the system needs for * rebuilding the program image on a machine with a * different memory size, also included is a checksum for * rudimentary error checking and for PROTECTION VIOLATION * A sequential SAVE : Maximum-length records are performed * to write the file and each record is copied into the VDP * from ERAM before it is written. *********************************************************** SAVE CLOG >80,@FLAG * PROTECTION VIOLATION BR ERRPV CALL GPNAME This will also close all file * Check SAVE "NAME", MERGE or SAVE "NAME", PROTECTED first CLR @SAPROT Clear "PROTECTED" flag XML PGMCHR CZ @CHAT EOL? BS SAZ1 Yes, no need to check any opt CEQ COMMAZ,@CHAT Has to be a comma here BR ERRSYN DCEQ >C805,V*PGMPTR Unquoted string with length 5 * has to be MERGE at this time BR G8DF4 DCEQ >4D45,V@2(@PGMPTR) "ME" of MErge * RXB PATCH CODE OPTION ADDED IV254 FOR SAVE 2015 ********* * SAVE "DSK#.FILENAME",MERGE ! SAVE MERGE FORMAT * SAVE "DSK#.FILENAME",IV254 ! SAVE IV254 PROGRAM FORMAT * SAVE "DSK#.FILENAME" ! NORMAL PROGRAM FORMAT OR IV254 * BR ERRSYN If not : SYNTAX ERROR BR CIV254 CHECK FOR IV254 OPTION DCEQ >5247,V@4(@PGMPTR) "RG" of meRGe BR ERRSYN If not : SYNTAX ERROR CEQ >45,V@6(@PGMPTR) "E" of mergE BR ERRSYN If not : SYNTAX ERROR CZ V@7(@PGMPTR) Check for EOL BR ERRSYN Not EOL : SYNTAX ERROR BR SAVMG Go to handle this option * Has to be PROTECTED option here, crunched as unquoted str G8DF4 DCEQ >C809,V*PGMPTR Unquoted string with length 9 * has to be PROTECTED BR ERRSYN DCEQ >5052,V@2(@PGMPTR) "PR" of PRotected BR ERRSYN If not : SYNTAX ERROR DCEQ >4F54,V@4(@PGMPTR) "OT" of prOTected BR ERRSYN If not : SYNTAX ERROR DCEQ >4543,V@6(@PGMPTR) "EC" of protECted BR ERRSYN If not : SYNTAX ERROR DCEQ >5445,V@8(@PGMPTR) "TE",of protecTEd BR ERRSYN If not : SYNTAX ERROR CEQ >44,V@10(@PGMPTR) "D" of protecteD BR ERRSYN If not : SYNTAX ERROR CZ V@11(@PGMPTR) Check EOL BR ERRSYN INC @SAPROT *********************************************************** SAZ1 CZ @RAMTOP If ERAM NOT present then BR G8E42 ***** CLEAR THE BREAKPOINT IN VDP ALONE TO SPEED UP ******* DST @STLN,@FAC8 End of line # buffer G8E33 AND >7F,V*FAC8 Clear the breakpoint DADD 4,@FAC8 Move to the next one DCH @ENLN,@FAC8 Until done BR G8E33 BR VSAVZ G8E42 CALL UBSUB Clear the breakpoint in ERAM DST @RAMTOP,@MNUM Top of memory in ERAM DSUB @STLN,@MNUM DINC @MNUM # of bytes total in ERAM DST @HIVDP,@VAR0 Top of memory in VDP DSUB @MNUM,@VAR0 DINC @VAR0 * Check is there enough memory in VDP to move the program * text and line number table from ERAM to VDP GT Not enough memory in VDP for sur BR GSAVE * RXB PATCH CODE FOR VDPSTACK * DST VRAMVS+64+256,@VAR5 * 64 bytes are for safety bu DST @>836E,@VAR5 DADD 64+256,@VAR5 * DSR routine give file error when loading a program which * VDP maximum size and was saved from VDP to be a program * on disk when ERAM not exist. In order to fix this proble * restrict the program memory to be 256 bytes less then th * real space in VDP when ERAM not exist. DCHE @VAR5,@VAR0 Not enough memory in VDP, do * sequential file save BR GSAVE DSUB 10,@VAR5 * 10 bytes for control informat CALL GVMOV Enough memory in VDP, move it * over and do the normal save l **************** Without ERAM, or after GVMOV ************* **************** do the normal save ************* VSAVZ DST @FREPTR,@STADDR Store additional control info DDEC @STADDR Back up some more for 2 byte DST @>8370,V*STADDR First current top of memory DDECT @STADDR DST @STLN,V*STADDR Then STLN DDECT @STADDR DST @ENLN,V*STADDR Then ENLN DDECT @STADDR Then DST @STLN,V*STADDR DXOR @ENLN,V*STADDR STLN XORed with ENLN CEQ 1,@SAPROT Check is there PROTECTED opti BR G8E91 DNEG V*STADDR Negate the CHECKSUM to indica * LIST/EDIT protection G8E91 DST @STADDR,V@BUF(@PABPTR) Save start address in P DDEC @STADDR DST @>8370,V@RNM(@PABPTR) Compute # of bytes used DSUB @STADDR,V@RNM(@PABPTR) and store that in PAB CZ @RAMTOP If ERAM exists then BS G8EAD DST @BBB1,@STLN Restore the original STLN, EN DST @CCC1,@ENLN which points to ERAM G8EAD CALL IOCALL Call Device Service Routine f BYTE CZSAVE * SAVE operation LRTOPL CALL KILSYM Release string space/symbol t B TOPL15 Go back to toplevel *********************************************************** * Open the sequential file, set the PAB * File type : sequential file * Mode of operation : output * Data type : internal * Record type : variable length records * Logical record length : 254 maximum GSAVE MOVE 9,G@PAB3,V@4(@PABPTR) Build the PAB DECT V@FLG(@PABPTR) Put in the correct I/O mode : * Compute the data buffer address DST @>8370,@FAC DSUB 253,@FAC DST @FAC,V@BUF(@PABPTR) DST @FAC,@EEE1 Save it for later use in GVWITE CALL CDSR Call device service routine to o BR ERRZ2B Return with ERROR indication in * Put 8 bytes control info at the * beginning of the data buffer DST >ABCD,V*FAC >ABCD indentifies a program f DINCT @FAC when doing LOAD later DST @STLN,V*FAC Save STLN in control info DINCT @FAC DST @ENLN,V*FAC ENLN too DINCT @FAC DST @STLN,V*FAC DXOR @ENLN,V*FAC Save the checksum CEQ 1,@SAPROT Check is there PROTECTED opti BR G8EFB DNEG V*FAC Negate the CHECKSUM to indica * the LIST/EDIT protection G8EFB DINCT @FAC DST @RAMTOP,V*FAC Save the top of memory info ST 10,V@CNT(@PABPTR) Set the caracter count in PAB CALL IOCALL Call device service routine BYTE CZWRIT * With I/O opcode : write, to s * the control info for the first reco * Now start to use maximum-length record to write the file * and each record is copied into the VDP from ERAM bofore i * is written DST @STLN,@DDD1 Starting address on ERAM * DST @>8370,@EEE1 @EEE1 has been set up before * DST 253,@EEE1 Starting address of the data * buffer on VDP DST @RAMTOP,@CCC1 DSUB @STLN,@CCC1 DINC @CCC1 ST 254,V@CNT(@PABPTR) Set the character count of P G8F1C DST 254,@FFF1 @FFF1 byte count XML GVWITE Move data from ERAM to VDP CALL IOCALL Call device service routine BYTE CZWRIT DADD 254,@DDD1 Update the source addr on ERA DSUB 254,@CCC1 # of bytes left to move BS GSAV1 No more bytes to save DCHE 254,@CCC1 Leave the last record alone BS G8F1C * Move the last @CCC1 bytes from ERAM to VDP DST @CCC1,@FFF1 @FFF1 : Byte count XML GVWITE Write data from ERAM to VDP ST @CCC1+1,V@CNT(@PABPTR) Update the character cou * in PAB CALL IOCALL Call device service routine BYTE CZWRIT GSAV1 CALL IOCALL BYTE CZCLOS * Close the file BR LRTOPL Continue *********************************************************** * Move the program text & line # table to VDP, and relocate GVMOV DST @STLN,@BBB1 Save STLN, ENLN for later use DST @ENLN,@CCC1 DST @STLN,@DDD1 Source addr on ERAM DST @VAR5,@EEE1 Destination addr on VDP DST @EEE1,@STADDR Use later for RELOCA DST @RAMTOP,@FFF1 DSUB @STLN,@FFF1 # of bytes to move DINC @FFF1 @FFF1 : byte count for GVWITE XML GVWITE Move from ERAM to VDP DST @RAMTOP,@OLDTOP Set up @RAMTOP for old top * of memory DST @>8370,@NEWTOP Set up @>8370 for new top * of memory CALL RELOCA Relocate the program DST @STLN,@FREPTR Set up @FREPTR DDEC @FREPTR RTN *********************************************************** * Save the crunched form of a program into a file. * Move the line number and text to the crunch buffer, then * write to the file one line at a time. *********************************************************** * Open the file with: * I/O opcode : OPEN * File type : SEQUENTIAL file * Mode of operation : OUTPUT * Data type : DISPLAY type data * Record type : VARIABLE LENGTH records * Data buffer address : Crunch buffer address * Logical record length : 163 (length of curnch buffer + 2 * bytes for line #) maximum SAVMG MOVE 9,G@PAB1,V@4(@PABPTR) Build PAB CALL IOCLZ1 Call the DSR routine to open fil DST @ENLN,@FAC6 Start from the first line # DSUB 3,@FAC6 @FAC6 now points to the 1st line * Write to the file from crunch bu * one line at a time G8F88 CLR @VAR0 Make it a two byte later CZ @RAMTOP If ERAM exists then BS G8FB6 DST @FAC6,@DDD1 Write the 4 bytes (line # and * line pointer) from ERAM to * crunch buffer * @DDD1 : Source address on ERA DST CRNBUF,@EEE1 @EEE1 : Destination address * on VDP DST 4,@FFF1 @FFF1 : byte count XML GVWITE Write data from ERAM to VDP DST V@CRNBUF+2,@DDD1 Line pointer now points to * length byte DDEC @DDD1 Get the length of this line * @DDD1 : Source address on ERA DINC @FFF1 @FFF1 : Byte count, coming ba * from GVWITE above, =0 XML GREAD1 Read the length byte from ERA ST @EEE1,@VAR0+1 @EEE1 : Destination addr on C DST CRNBUF+2,@EEE1 Write the text from ERAM to 3 * byte of crunch buffer * @EEE1 : Destination addr on V * @DDD1 : Source addr on ERAM DINC @DDD1 Back to point to the text DST @VAR0,@FFF1 @FFF1 : Byte count XML GVWITE Write data from ERAM to VDP BR G8FCD ERAM not exist : line # table * and text in VDP G8FB6 DST V*FAC6,V@CRNBUF PUT THE LINE # IN DST V@2(@FAC6),@FAC2 Get the line pointer out DDEC @FAC2 Line pointer now points to th * length byte ST V*FAC2,@VAR0+1 Get the length out * Move the text into the crunch buffer MOVE @VAR0,V@1(@FAC2),V@CRNBUF+2 G8FCD AND >7F,V@CRNBUF Reset possible breakpoint DINCT @VAR0 * Total length=text length+line # len ST @VAR0+1,V@CNT(@PABPTR) Store in the cahracter c CALL IOCALL Call the device service routi BYTE CZWRIT * Write DSUB 4,@FAC6 Go to the next line # DCHE @STLN,@FAC6 Finish moving all BS G8F88 DST >FFFF,V@CRNBUF Set up a EOF for the last rec ST 2,V@CNT(@PABPTR) Only write this 2 bytes CALL IOCALL Call the device service routi BYTE CZWRIT * Write CALL IOCALL Call the device service routi BYTE CZCLOS * Close the file BR LRTOPL Go back to top level * DV163 PAB1 BYTE >00,>12,>08,>20,>A3,>00,>00,>00,>60 * >0820 = CRNBUF * >A3 = 163 * >60 = OFFSET *********************************************************** * MERGE ROUTINE * MERGE load a file which is in crunched program form into * the CRNBUF one record (one in) at a time then take the * line # out in FAC, text length into @CHAT, and edit it * into the program. Identify EOF by the last record which * is set up at SAVE time. *********************************************************** MERGE CALL GPNAME Close all file, set up PAB CLOG >80,@FLAG Check PROTECTION VIOLATION BR ERRPV * To fix the bug #06 in MERGE XML PGMCHR Check EOL CZ @CHAT BR ERRSYN Not EOL : SYNTAX ERROR * Open the file with * I/O opcode : OPEN * File type : SEQUENTIAL file * Mode of operation : INPUT * Data type : DISPLAY type data * Record type : VARIABLE LENGTH records * Data buffer address : crunch address * Logical record length : 163 maximum MOVE 9,G@PAB1,V@4(@PABPTR) Set up PAB INCT V@FLG(@PABPTR) Put in correct I/O mode : >14 CALL IOCLZ1 Call the device service routi * to open the file CALL IOCALL Call the device service routi BYTE CZREAD * to read DCEQ >FFFF,V@CRNBUF If 1st rec is EOF BS ERRZ2B G902A DCLR @>83D6 Read in one line and edit it * program ST V@CNT(@PABPTR),@CHAT Length of this record DECT @CHAT Text length = total length-2 * (line # length) * Put it in @CHAT for EDITLN DST V@CRNBUF,@FAC Put the line # in @FAC for ED CLR @FAC12 Make it a double byte ST @CHAT,@FAC13 * Move the text up 2 bytes MOVE @FAC12,V@CRNBUF+2,V@CRNBUF DST @PABPTR,V@MRGPAB SAVE PAB POINTER CALL EDITLN EDIT IT TO THE PROGRAM DCLR @PABPTR Clear temporary PAB pointer DEX V@MRGPAB,@PABPTR Restore old PAB pointer CALL IOCALL CALL THE DEVICE SERVICE ROUTI BYTE CZREAD * read another record or anoth * line DCEQ >FFFF,V@CRNBUF End of EOF BR G902A * Double check EOF record MERGZ1 CEQ 2,V@CNT(@PABPTR) I/O ERROR BR ERRZ2B CALL IOCALL Call the device service routi BYTE CZCLOS * close the file BR LRTOPL Go back to top level *********************************************************** * LIST ROUTINE * List lists a readable copy of the current program imnage * to the specified device. In case no device is specified, * the listing is copied to the screen. * This routine uses the fact that ERRZZ returns to the * caller if the call has been issued in EDIT which will * reinitiate the variable stuff. *********************************************************** LIST CLOG >80,@FLAG PROTECTION VILOATION ERROR < BR ERRPV < DCLR @CURLIN Create some kind of control < DCLR @CURINC for defaults < ST MINUS,@VARC Select "-" as separator < * GKXB GKLIST label CALL GTLIST GKXB pick up length * If either CURLIN or CURINC is non-zero, use it * For zero values replace the default (ENLN-3, STLN) DCZ @CURLIN BR G9094 DST @ENLN,@DDD1 Get the first lines line # DSUB 3,@DDD1 DDD1 : Source address on ERAM CALL GRSUB3 Read the line # from ERAM/VDP BYTE DDD1 * @DDD1 : Source address on ERA * Reset possible breakpoint too DST @EEE1,@CURLIN Use standard default DCZ @CURINC BR G9094 LISTZ0 CALL GRSUB3 Read last line # from ERAM/VD BYTE STLN * @STLN : Source address on ERA * Reset possible breakpoint too DST @EEE1,@CURINC @EEE1 : Destination address o * Also default for end line * Now first evaluate what we've got in CURLIN G9094 DCZ @CURINC Check for combination xxx- BR G90A6 G9098 DDEC @VARW Backup to the separation mark CEQ SPACE+OFFSET,V*VARW BS G9098 CEQ MINUS+OFFSET,V*VARW Select last BS LISTZ0 G90A6 DCHE @CURLIN,@CURINC If something like LIST 15-11 BS G90AE DST @CURLIN,@CURINC Replace byt LIST 15-15 G90AE DST @CURLIN,@FAC Prepare for line # search XML SPEED Search the line number table BYTE SEETWO DST @EXTRAM,@CURLIN Get first real line # in CURL DST @CURINC,@FAC XML SPEED BYTE SEETWO * Evaluate second line # CALL GRSUB3 Read 2 bytes of data from ERA BYTE EXTRAM * @EXTRAM : Source addr on ERAM * Reset possible breakpoint too DCH @CURINC,@EEE1 BR G90CA DADD 4,@EXTRAM Else take next lower line G90CA DST @EXTRAM,@CURINC Which could be equal to CURLI DST @CURLIN,@EXTRAM For use below by LIST DDEC @PGMPTR Backup to last CHAT XML PGMCHR Retrieve last CHAT CZ @CHAT Device name available BS G9132 CALL CLSALL Close all files that are open DST VRAMVS,@VSPTR Re-initialize the V-stack DST @VSPTR,@STVSPT And it's base XML PGMCHR Get name length in CHAT DST VRAMVS+16,@PABPTR Get entrypoint in PAB CLR @DSRFLG Indicate device I/O MOVE 9,G@PAB,V@4(@PABPTR) DST VRAMVS+16+NLEN,@CCPADR Select start address * for copy * GKXB GTLENGTH label CALL GTLENG GKXB Set length in PAB INC @FAC2 Plus length byte LISTZ1 ST @CHAT,V*CCPADR Copy the bytes one by one XML PGMCHR Get next character DINC @CCPADR CCPADR ends up with highest a DEC @FAC2 Count total # of characters BR LISTZ1 CALL IOCLZ1 Preform OPEN on DSR CLR @FAC Create double byte PAB length ST V@LEN(@PABPTR),@RECLEN Get record length ST @RECLEN,@FAC1 Get highest address used DADD @CCPADR,@FAC Compute record length DST @CCPADR,V@BUF(@PABPTR) Store it CZ @RAMTOP If ERAM exists then BS G9128 DCH @>8370,@FAC Compare with top of * VDP : if higher then 'not enough room' BS ERRIO BR G912D G9128 DCH @STLN,@FAC Not enough room BS ERRIO G912D ST 1,@CCPPTR Clear first line in output BR G9138 G9132 ST VWIDTH+3,@XPT For common code usage CALL INITKB Reset current record length G9138 CZ @RAMTOP If ERAM exist then BS G9140 CALL GRMLST Fake it : move each line to t * CRUNCH buffer form ERAM G9140 CALL LLIST List the current line SCAN Test for a break key BR LISTZ3 No key CEQ BREAK,@RKEY BS LISTZ4 LISTZ5 SCAN BR LISTZ5 LISTZ3 CZ @RAMTOP If ERAM exists BS G9156 DST @FAC14,@EXTRAM Restore the @EXTRAM G9156 DSUB 4,@EXTRAM Pointer to next line DCH @EXTRAM,@CURINC Display all lines in range BR G9138 LISTZ4 CZ @DSRFLG Device I/O -> output last rec BR G916D CALL OUTREC Output the last record CALL IOCALL Close the device properly BYTE CZCLOS B TOPL10 G916D B TOPL15 Restart the variable too * PAB image used in LIST function PAB BYTE 0,>12,0,0,0,0,0,0,OFFSET * Move each line in ERAM to CRNBUF area, put line number in * (CRNBUF), put CRNBUF+4 in (CRNBUF+2) which is the line * pointer field, put the text itself from ERAM to (CRNBUF+4 * before call LLIST, trick it by moving CRNBUF to @EXTRAM GRMLST CALL GRSUB3 Get line # from ERAM(use GREA BYTE EXTRAM * @EXTRAM : Source address on E * Reset possible breakpoint too DST @EEE1,V@CRNBUF Put it in CRNBUF DST CRNBUF+4,V@CRNBUF+2 Put CRNBUF+4 into * the line pointer field DINCT @DDD1 Get the pointer to the text * from GRAM CALL GRSUB4 Read the line pointer in (use * GREAD1) DDEC @EEE1 Get the ptr to the length byt CALL GRSUB2 Read th length from ERAM, use BYTE EEE1 * GREAD1, @EEE1 : Source addre * on ERAM ST @EEE1,@FFF1+1 Use the length as byte count * to move the text from ERAM to * VDP CRNBUF+4 area DST CRNBUF+4,@EEE1 EEE1 : Destination address on DINC @DDD1 DDD1 : Source address on ERAM XML GVWITE Move data from ERAM to VDP DST @EXTRAM,@FAC14 Save for later use DST CRNBUF,@EXTRAM Fake it RTN * SUBROUTINE TO READ 2 BYTES OF DATA FROM ERAM OR VDP WITH * THE OPTION TO RESET THE POSSIBLE BREAKPOINT GRSUB2 FETCH @FFF1 Fetch the source address on DST *FFF1,@DDD1 ERAM or VDP * @DDD1 : Source addr on ERAM * or VDP GRSUB4 CZ @RAMTOP If ERAM exists BS G91B7 DST 2,@FFF1 @FFF1 : Byte count XML GREAD1 Read data from ERAM to CPU BR G91BB G91B7 DST V*DDD1,@EEE1 Read data from VDP to CPU G91BB RTN GRSUB3 FETCH @FFF1 Fetch the source addr on ERAM DST *FFF1,@DDD1 or VDP * @DDD1 : Source addr on ERAM/V CALL GRSUB4 Do the actual read DAND >7FFF,@EEE1 Reset possible breakpoint RTN *********** REC ROUTINE *********************************** * REC(X) returns the current record to which file X is * positioned. SUBREC DST @PABPTR,@ARG Save the current PAB & set ne CALL SUBEOF Try to find the correct PAB DEX @PABPTR,@ARG @ARG : new PAB * @PABPTR : restore current PAB BR EOFZ2 Didn't find the corresponding DST V@RNM(@ARG),@FAC Obtain integer record number XML CIF Convert integer to floating XML CONT and continue *********************************************************** * EOF ROUTINE * EOF(X) returns status codes on file X. The meaning of the * result codes is: * -1 Physical End Of File * 0 Not at End Of File yet * 1 Logical End Of File *********************************************************** EOF DST @PABPTR,@ARG Save the current PAB and set * the new one in SUBEOF CALL SUBEOF Try to find the PAB somewhere BR ERRFE Can't file ST CZSTAT,@ARG2 Select status code without EX @ARG2,V@COD(@PABPTR) destorying original code CALL IOCLZ1 Get the info from DSR DEX @ARG,@PABPTR Restore original PAB and orig ST @ARG2,V@COD(@ARG) I/O code ST V@SCR(@ARG),@ARG2 And pick up STATUS MOVE 8,G@FLOAT1,@FAC Get floating 1 CLOG 3,@ARG2 Test EOF bits BS EOFZ2 No EOF indication CLOG 2,@ARG2 Physical EOF BS G9210 DNEG @FAC Make result -1 G9210 XML CONT EOFZ2 DCLR @FAC Create result 0 XML CONT FLOAT1 BYTE >40,1,0,0,0,0,0,0 * Floating point -1 SUBEOF CEQ LPARZ,@CHAT * SYNTAX ERROR BR ERRSYN XML PARSE Parse up to the matching ")" BYTE >FF CALL CHKCNV Convert and search for PAB BS ERRBV Avoid 0's and negatives bad v ST @DSRFLG,@ARG6 @DSRFLG got changed in CHKCON CALL CHKCON Check and search tiven filenu ST @ARG6,@DSRFLG @DSRFLG to changed CHKCON RTNC Condition set : file # exists *********************************************************** * LOAD / SAVE / MERGE UTILITY ROUTINE * GPNAME gets program name from OLD and SAVE * Can also be used for future implementation of REPLACE * statement. Also gives valuable contribution to updating * of program pointers (VSPTR, STVSPT, FLAG, etc...) and * creation of LOAD/SAVE PAB *********************************************************** GPNAME AND >80,@FLAG Avoid returns from ERRZZ rout CEQ STRINZ,@CHAT BS G9242 CEQ NUMZ,@CHAT * SYNTAX ERROR BR ERRSYN G9242 CALL CLSALL First close all open files CALL KILSYM Kill the symbol table DST VRAMVS+8,@PABPTR Create PAB as low as possible CLR V*PABPTR Clear PAB with ripple-move MOVE PABLEN-5,V*PABPTR,V@1(@PABPTR) XML PGMCHR Get length of file-specificat DSUB 4,@PABPTR Make it a regular PAB ST @CHAT,V@NLEN(@PABPTR) Copy name length to PAB DST V@NLEN-1(@PABPTR),@STADDR Avoid problems(bugs!) CZ @RAMFLG If ERAM not exist or imperati BR G9275 MOVE @STADDR,V*PGMPTR,V@NLEN+1(@PABPTR) BR G9284 G9275 DST @STADDR,@FFF1 @FFF1 : Byte count DST @PGMPTR,@DDD1 Source address on ERAM DST @PABPTR,@EEE1 DADD NLEN+1,@EEE1 Destination address on VDP XML GVWITE Write from ERAM to VDP G9284 DADD @STADDR,@PGMPTR Skip the string * OLD and SAVE can only be imperative CLR @DATA Clear DATA line RTN That's all folks *********************************************************** * READ / INPUT UTILITY ROUTINES *********************************************************** GETVAR DST @PGMPTR,@STADDR Save token pointer to first c CLR @VAR5 Clear # of parsed variables DST @VSPTR,@VAR4 Save first entry in V-stack * Start parse cycle for IMPUT statement GETVZ0 CHE >80,@CHAT Make sure of varialbe name BS ERRSYN XML SYM Get correct symbol table entr CLR @VAR6 Start with zero paren nesting GETVZ1 CEQ LPARZ,@CHAT Increment counter for "(" BR G92A2 INC @VAR6 G92A2 CZ @VAR6 Watch out for final balance BS G92B6 CALL CHKEND Check for unbalenced parenthe BS ERRSYN Somebody forgot something!!!! CEQ RPARZ,@CHAT Decrement for ")" BR G92B2 DEC @VAR6 G92B2 XML PGMCHR Get character following last BR GETVZ1 G92B6 XML VPUSH Push entry to V-stack INC @VAR5 Count all pushed variables CALL CHKEND Next should either be EOS or BS GETVZ2 Found it EOS!!!! XML SPEED Must be at a BYTE SYNCHK * comma else BYTE COMMAZ * its an error CALL CHKEND Check for end of statement BR GETVZ0 Haven't found it yet CZ @DSRFLG Error for keyboard I/O BR ERRSYN GETVZ2 RTN * Create a temporary string in memory. BYTES contains the l CTSTR DST >6500,@FAC2 Indicate string in FAC CTSTR0 DST @BYTES,@FAC6 Copy string length in FAC6 XML GETSTR Reserve the string DST @SREF,@FAC4 Copy start address of string DST >001C,@FAC And indicate temp. string >00 RTN * Create a temporary string from TEMP5. Length is given * in BYTES. CTMPST CALL CTSTR Create the temporary string CZ @FAC7 BS G92EB MOVE @BYTES,V*TEMP5,V*SREF G92EB RTN Non-empty * CHKNUM - Check for numeric argument CHKNUM CEQ NUMZ,@VAR0+1 BR G9303 CALL GETRAM Get string length DST @DATA,@FAC12 Store entry for conversion CLR @VAR0 Prepare for double action DADD @VAR0,@DATA Get end of data field CALL CONV1 Convert data to FAC # * Conversion should also end at end of field DCEQ @DATA,V@CSNTMP Set COND according to equalit G9303 RTNC Back to caller GETGFL ST @RAMTOP,@FAC3 Select target memory GETDAT CZ @FAC3 Get everything from RAM BR G9314 GETRAM ST V*DATA,@VAR0+1 Get data in VAR0+1 CLR @FAC3 Be sure FAC3 = 0 !!!! BR G9320 G9314 DST 1,@FFF1 FFF1 : byte count DST @DATA,@DDD1 DDD1 : source addr on ERAM XML GREAD1 Read data from ERAM ST @EEE1,@VAR0+1 EEE1 : Destination addr on CP G9320 DINC @DATA Go to next datum for next tim RTN CHKSTR DCLR @FAC6 Assume we'll have an empty st CEQ STRINZ,@VAR0+1 BS CHKSZ0 CEQ NUMZ,@VAR0+1 See ............ BR EMPSTR CHKSZ0 CALL GETDAT Next datum is length byte CLR @FAC6 Be sure high byte = 0 !!!! ST @VAR0+1,@FAC7 Prepare FAC for string assign DST @DATA,@TEMP5 Save string addr for assignme DADD @FAC6,@DATA Update DATA for end of field RTN * Empty strings are handled below EMPSTR CEQ COMMAZ,@VAR0+1 BS G9348 CALL DATEND Check for end of data stateme BR RTC Return with COND if not EOS G9348 DDEC @DATA Backup data pointer for empti RTN DATEND EX @VAR0+1,@CHAT CALL CHKEND Check for EOS (=EOL or "::") EX @VAR0+1,@CHAT Restore original situation RTNC *********************************************************** * OPEN / CLOSE / RESTORE UTILITY ROUTNE * CHKFN - Check for token = "#" and collect and check * filenumber. Also convert filenumber to (two byte) integer * and check for range 080,@FAC Negative result BR RTC DCZ @FAC And return with COND set/rese RTNC CHKCON ST @FAC1,@FNUM Move result into FNUM * Check for high byte not zero (>0255) CZ @FAC Bad value error BR ERRBV * Search routine - Search for a given file number in the * chain of allocated PABs. * IOSTRT contains the start of the PAB - chain DST @IOSTRT,@PABPTR Get first link in the chain * Check for last PAB in the chain and exit if found CHKFZ1 DCZ @PABPTR Check if file # is correct BS G938F CEQ @FNUM,V@FIL(@PABPTR) BS RTC DST V*PABPTR,@PABPTR Try the next PAB BR CHKFZ1 RTC CEQ @>8300,@>8300 Force COND to "SET" G938F RTNC Exit with no COND change *********************************************************** * OUTEOF outputs the last record if this record is * non-empty, and if the PAB is open for non-imput mode * (UPDATE, APPEND or OUTPUT). *********************************************************** OUTEOF CLR @DSRFLG CEQ CZWRIT,V@COD(@PABPTR) Non-input mode BR G93A5 CZ V@OFS(@PABPTR) Non-empty record BS G93A5 CALL PRINIT Initiate for output CALL OUTREC Output and remove pending con G93A5 RTN Return to whoever called *********************************************************** * DELPAB routine - delete a given PAB from chain under the * assumption that the PAB exists *********************************************************** * First compute start and end address for block move DELPAB DST V@BUF(@PABPTR),@STADDR Get lowest used address DDEC @STADDR Make that an addr following P CLR @CCPADR Get highest addr in CCPADR (2 ST V@NLEN(@PABPTR),@CCPADR+1 complete the two byte ADD PABLEN-1,@CCPADR+1 Add PAB length-1 DADD @PABPTR,@CCPADR Compute actual addr within RA DCEQ @PABPTR,@IOSTRT Watch out for first PAB BS G93E6 DST @IOSTRT,@MNUM Figure out where link to PAB G93C2 DCEQ @PABPTR,V*MNUM Continue while not found BS G93CE DST V*MNUM,@MNUM Defer to next link in chain BR G93C2 Short end for code-savings G93CE DST V*PABPTR,V*MNUM Copy link over deleted PAB DCZ V*MNUM Adjust link only if not done BS G93E0 DADD @CCPADR,V*MNUM Add deleted # of bytes for DSUB @STADDR,V*MNUM link correction G93E0 DST V*MNUM,@PABPTR Get new PABPTR BR G93F7 G93E6 DST V*PABPTR,@IOSTRT Update first link DCZ @IOSTRT Only adjust if not last link BS G93F4 DADD @CCPADR,@IOSTRT Add deleted # of bytes DSUB @STADDR,@IOSTRT G93F4 DST @IOSTRT,@PABPTR Get new PABPTR * Move the bytes below the deleted block up in memory. This * includes both variables and PABs G93F7 DST @STADDR,@MNUM Get # of bytes to move DSUB @FREPTR,@MNUM DST @CCPADR,@CCPPTR Save destination address G9400 DCZ @MNUM BS G9411 ST V*STADDR,V*CCPADR Move byte by byte DDEC @STADDR Update source DDEC @CCPADR and destination pointers DDEC @MNUM Also update counter value BR G9400 G9411 DSUB @STADDR,@CCPADR Compute # of bytes of old PAB DCZ @PABPTR Avoid trouble with last PAB BS G9431 G9418 DCZ V*PABPTR Ad infinitum (or fundum) BS G942C DADD @CCPADR,V*PABPTR Adjust link to next PAB DADD @CCPADR,V@BUF(@PABPTR) Update the buffer link DST V*PABPTR,@PABPTR Get next link in chain BR G9418 G942C DADD @CCPADR,V@BUF(@PABPTR) Update buffer link * Adjust symbol table links G9431 DCZ @SYMTAB BS G94B4 DCGE @CCPPTR,@SYMTAB Only update lower links BS G94B4 DADD @CCPADR,@SYMTAB Get symbol table pointer back DST @SYMTAB,@PABPTR Get pointer for update DELPZ1 CZ @RAMTOP BR DELPZ2 DCGE @STLN,V@4(@PABPTR) If imperative BS G9451 DELPZ2 DADD @CCPADR,V@4(@PABPTR) Adjust name pointer G9451 CGE 0,V*PABPTR If string-fix breakpoints BS G949B ST >07,@FAC Mask to get # of dims AND V*PABPTR,@FAC Get # of dims DST @PABPTR,@FAC2 Pointer to 1st dim max DADD 6,@FAC2 or string pointer DST 1,@FAC6 Number of pointers to change CLR @FAC4 For 2 byte use of option base G946B CZ @FAC While more dimendions BS G9483 ST 1,@FAC5 Assume option base 0 SUB @BASE,@FAC5 But correct if base 1 DADD V*FAC2,@FAC4 Get dim maximum DMUL @FAC6,@FAC4 Multiply it in DEC @FAC Next dim DINCT @FAC2 B G946B * FAC2 now points at the 1st string pointer * FAC6 contains the # of pointers that need to be changed G9483 DCZ @FAC6 While pointers to cheange BS G949B DST V*FAC2,@FAC Get pointer to string DCZ @FAC If sting is non-null BS G9495 DST @FAC2,V@-3(@FAC) Fix backpointer G9495 DINCT @FAC2 Point to next pointer DDEC @FAC6 One less pointer to change BR G9483 G949B DCZ V@2(@PABPTR) BS G94B4 DCGE @CCPPTR,V@2(@PABPTR) BS G94B4 DADD @CCPADR,V@2(@PABPTR) Adjust next value link DST V@2(@PABPTR),@PABPTR Next entry BR DELPZ1 G94B4 DADD @CCPADR,@FREPTR Update free word pointer RTN *********************************************************** * CNVDEF - Convert to 2 byte integer and default to 1 on * negative or 0 .... *********************************************************** CNVDEF CALL CHKCNV Check and convert BR CNVDZ0 DST 1,@FAC Default to 1 or minus and 0 CNVDZ0 RTN And return without COND set *********************************************************** * PARREC parses a possible REC clause in INPUT, PRINT or * RESTORE. In case a comma is detected without a REC clause * following it, the COND is set upon return. In case a REC * clause is specified for a file opened for SEQUENTIAL * access, a * FILE ERROR is given. *********************************************************** PARREC CEQ COMMAZ,@CHAT Only check if we have a "," BR G94EE XML PGMCHR Check next token for REC CEQ RECZ,@CHAT May be USING clause BR RTC CLOG 1,V@FLG(@PABPTR) BS ERRFE XML PGMCHR Get first character of expres CALL OUTEOF Output possible pending outpu CLR V@OFS(@PABPTR) Clear record offset XML PARSE Translate the expression in R BYTE COLONZ CALL CHKCNV Check numeric and convert to CGE 0,@FAC 2 byte integer, Bad Value BR ERRBV DST @FAC,V@RNM(@PABPTR) Store actual record number G94EE RTN *********************************************************** * DISPLAY / ACCEPT UTILITIES *********************************************************** DISACC CALL INITKB PABPTR is used as flag (no DS DISPZ1 CEQ ERASEZ,@CHAT Check for ERASE ALL BR G9518 CLOG 1,@PABPTR already used once BR ERRSYN XML PGMCHR Check next token for ALL XML SPEED BYTE SYNCHK * has to be ALL BYTE ALLZ ALL BKGD+OFFSET Clear screen to background co ST 3,@XPT Reset pending output pointer CLOG 4,@PABPTR Didn't use AT yet BR G9513 ST 1,@CCPPTR Reset column pointer DST SCRNBS+2,@CCPADR and screen base address G9513 OR 1,@PABPTR Set "ERASE USED" flag BR DISPZ1 Try next token G9518 CEQ BEEPZ,@CHAT delay action for BEEP BR G9529 CLOG 2,@PABPTR Use it only once BR ERRSYN OR 2,@PABPTR No syntax error detected here XML PGMCHR Evaluate next token BR DISPZ1 Get set for second pass G9529 CEQ ATZ,@CHAT Generate "AT" clause BR G9571 CLOG 4,@PABPTR Second usage not BR ERRSYN XML PGMCHR allowed.... XML SPEED BYTE SYNCHK * Skip left parenthesis BYTE LPARZ XML PARSE Now parse any expression BYTE COMMAZ XML SPEED BYTE SYNCHK * Check for "," and skip it BYTE COMMAZ CALL CNVDEF Convert to 2 byte numeric ST 24,@FAC2 Convert modulo 24 (# screen l CALL COMMOD Compute remainder DEC @FAC1 Convert back to 0 (range was MUL 32,@FAC1 Convert to line base address DST @FAC1,@CCPADR And repalce CCPADR XML PARSE Parse column expression BYTE RPARZ XML SPEED BYTE SYNCHK * Check for ")" at end BYTE RPARZ CALL CNVDEF Again convert to two byte int ST VWIDTH,@FAC2 Convert modulo video width CALL COMMOD Compute remainder ST @FAC1,@CCPPTR Select current column DADD @FAC,@CCPADR Compute full address DINC @CCPADR Adjust for column 0 (offset-1 OR 4,@PABPTR Set "AT-CLAUSE" used flag OR 32,@PABPTR Set "NON-STANDARD SCREEN ADDR BR DISPZ1 Continue for next item G9571 CEQ SIZEZ,@CHAT "SIZE" clause BR G95A0 CLOG 8,@PABPTR Only use once BR ERRSYN XML PGMCHR Get character following the S CEQ LPARZ,@CHAT has to open "(" BR ERRSYN XML PARSE And close again ")" BYTE VALIDZ CGE 0,@FAC Change to positive argument BS G958F DNEG @FAC For ACCEPT statement with siz OR >80,@PABPTR indicate in highest bit G958F CALL CHKCNV BS ERRBV * BAD VALUE CZ @FAC Also for args >255 (less then BR ERRBV ST @FAC1,@PABPTR+1 Copy to PABPTR (always used) OR 8,@PABPTR Prevent further use BR DISPZ1 and go on G95A0 CEQ VALIDZ,@CHAT Exclude VALIDATE option BS G95B9 * Start evaluating ERASE clause here CLOG 8,@PABPTR BS CHKEND CALL SIZE1 Evaluate field defined in SIZ * If it's no DISPLAY keyword ( AT, SIZE, BEEP or USING) it * has to be a print separator or colon ":" * If anything is specified is has to be a colon or end of * line... for end-of-line output current record * Check for end of statement CHKEND CLOG >80,@CHAT BS G95B7 CHE TREMZ+1,@CHAT BR RTC G95B7 CZ @CHAT Set COND according to CHAT G95B9 RTNC *********************************************************** * NXTCHR - Get next program character - skip all strings, * numerics and line references... *********************************************************** NXTCHR CALL CHKEND Check for end of statements BS RTC Avoid end of statement CEQ STRINZ,@CHAT Skip all strings BS NXTCZ0 CEQ NUMZ,@CHAT and numerics/unquoted string BR G95D5 NXTCZ0 XML PGMCHR Get string length ST @CHAT,@FAC1 Make that a double please... CLR @FAC Hic.... Oops, sorry DADD @FAC,@PGMPTR Back to the serious stuff BR G95DC G95D5 CEQ LNZ,@CHAT Line # = skip 2 tokens BR G95DC DINCT @PGMPTR <----------- That's the skip G95DC XML PGMCHR Get the next token RTN *********************************************************** * PRINT / DISPLAY UTILITES * Use the parameters specified in SIZE for further * evaluation of the limited field length *********************************************************** SIZE1 CLOG 4,@PABPTR Not "AT" clause used BR G95FC CEQ 1,@CCPPTR Might have to print current BS G95FC ST @CCPPTR,@FAC Compute final position after ADD @PABPTR+1,@FAC in FAC and compare with reco DEC @FAC CH @RECLEN,@FAC Size clause too long BR G95FC * We can't get here for AT( , ) output, since right margin * limited there CALL OUTREC Advance to next line CALL SCRO Scroll the screeen G95FC SUB @CCPPTR,@RECLEN Limit field size to available INC @RECLEN space... including current p CH @PABPTR+1,@RECLEN BR INITZ1 ST @PABPTR+1,@RECLEN Only accept if available BR INITZ1 Reinitialize CCPPTR * Copy (converted) numerical datum in string RSTRING ST @FAC12,@BYTES+1 Get actual string length CLR @BYTES Create double byte value CALL CTSTR Create a temporary string MOVE @BYTES,*FAC11,V*SREF Copy value string RTN * COMMOD - Compute FAC module FAC2 COMMOD DIV @FAC2,@FAC Compute remainder CZ @FAC1 Avoid zero remainders BR G9624 ST @FAC2,@FAC1 Assume maximum remainder G9624 CLR @FAC Clear upper byte RTN * TSTSEP tests for separator in print and branches to the * correct evaluation routine. * If no separator is found, simple return. * Test case end of line TSTSEP CALL CHKEND BR TSTSZ0 DST EOLEX,*SUBSTK Replace return address with E TSTSZ0 CHE COMMAZ,@CHAT BR TSTSZ1 CH COLONZ,@CHAT BS TSTSZ1 DST PRSEM,*SUBSTK Expect it to be a ";" CALL TSTINT Test for INTERNAL files BR TSTSZ1 Treat all separators as ";" CEQ COMMAZ,@CHAT BR G964F DST PRTCOM,*SUBSTK G964F CEQ COLONZ,@CHAT BR TSTSZ1 DST PRCOL,*SUBSTK TSTSZ1 RTN * PARFN - Parse string expression and create PAB automatica * continue in CSTRIN for copy string to PAB * Exit on non-string values * * First evaluate string expression PARFN XML PARSE Parse up to next comma <<< BYTE COMMAZ * <<< CEQ STRVAL,@FAC2 Check for "STRING" <<< BR ERRSNM DST @FAC6,@MNUM Copy length byte in MNUM ADD PABLEN,@MNUM+1 Account for PAB length+contro XML VPUSH Save start of string somewher DST @MNUM,@FAC Setup for MEMCHK - check for XML MEMCHK memory overflow BS ERRMEM * MEMORY FULL XML VPOP Restore all FAC information a DSUB @MNUM,@FREPTR Update free word pointer DST @FREPTR,@PABPTR Assign PAB entry address DINC @PABPTR Correct for byte within PAB CLR V*PABPTR Clear PAB plus control info MOVE PABLEN-1,V*PABPTR,V@1(@PABPTR) Ripple byte ST @MNUM+1,V@OFS(@PABPTR) Save length of PAB ST @FAC7,@MNUM Compute # of bytes in name ST @FAC7,V@NLEN(@PABPTR) Store name length ST @FNUM,V@FIL(@PABPTR) Copy file number in PAB DST @PABPTR,@CCPADR Get start addr for string des DADD NLEN+1,@CCPADR Add offset to actual start ad * TRICKY - OPTFLG also results offset added in CSTRIN CLR @OPTFLG Clear all option flags XML IO CSTRIN I/O UTILITY BYTE CSTRIN RTN *********************************************************** * OUTREC * OUTREC and INITRC are used to output a record to either * screen or external I/O devices, and to initiate pointers * for further I/O. *********************************************************** OUTREC ST @RECLEN,@MNUM+1 Compute number of characters INC @MNUM+1 positions we should fill CZ @DSRFLG Screen I/O BS G96D3 XML IO Fill the remainder of the rec BYTE FILSPC * with appropriate fillers CLOG 8,@PABPTR block output on size BR RTC CLOG 4,@PABPTR "AT CLAUSE USED" BS SCRO * Next test for xing the end of screen DADD 4,@CCPADR CHE 3,@CCPADR BR INITZ1 DST 2,@CCPADR Restart at upper left hand * corner of screen INITZ1 ST 1,@CCPPTR Reset current column pointer RTN SCRO XML SCROLL Scroll the screen one line ST 1,@CCPPTR Reinitialize CCPPTR BR INTKB0 and reinitialize * This is also entry for last record output G96D3 CLOG >10,V@FLG(@PABPTR) FIXED records BR G96E2 ST @RECLEN,@MNUM+1 Ready for space filling INC @MNUM+1 Move to first position outsid * record XML IO And do it up to end of record BYTE FILSPC G96E2 DEC @CCPPTR Update last character positio ST @CCPPTR,V@CNT(@PABPTR) Store # of characters CLR V@OFS(@PABPTR) Undo pending record offsets CALL IOCALL Call DSR BYTE CZWRIT * for WRITE mode CLR @CCPADR+1 Get address at buffer start BR PRZZ0 * PRINIT initializes the variable CCPADR, CCPPTR, RECLEN an * DSRFLG, for a given PABPTR. PRINIT CLR @DSRFLG Indicate external I/O in DSRF ST V@LEN(@PABPTR),@RECLEN Pick up record length ST V@OFS(@PABPTR),@CCPADR+1 Get offset in record PRZZ0 ST @CCPADR+1,@CCPPTR Compute columnar position INC @CCPPTR And convert from offset CLR @CCPADR Clear upper byte DADD V@BUF(@PABPTR),@CCPADR Compute actual address RTN *********************************************************** * OSTRNG - Copy the value of the string expression to the * screen. *********************************************************** OSTRNG ST @FAC7,@BYTES Pick up the string length G9711 CZ @BYTES Output as many records as req BS G973E * CHKREC check available space in current record. * If the string to be output is too long, it is chuncked up * into digestable pieces. If the current record is partly * filled up, it is output before any chuncking is done. CHKREC ST @CCPPTR,@MNUM+1 Use MNUM for current offset i CHKRZ0 ST @RECLEN,@MNUM Compute remaining area SUB @CCPPTR,@MNUM between column and end INC @MNUM Also count current column CHE @BYTES,@MNUM Won't fit in current record BS G9730 CEQ 1,@MNUM+1 Unused record BS CHKRZ1 CALL OUTREC Output whatever we have BR CHKREC And try again RTN G9730 ST @BYTES,@MNUM Use actual count if fit CHKRZ1 SUB @MNUM,@BYTES Update remaining chars count ADD @MNUM,@CCPPTR Also new column pointer XML IO Copy string to output BYTE CSTRIN BR G9711 Continue as long as needed G973E RTN *********************************************************** * INITKB - Initialize the variable needed for keyboard outp *********************************************************** INITKB CLR @PABPTR Don't use any DISPLAY options ST OFFSET,@DSRFLG Load for correction of screen ST 1,@CCPPTR Assume un-initialized XPT CH 2,@XPT * Patch for un-initialized XP BR G9751 ST @XPT,@CCPPTR Initialize CCPPTR DECT @CCPPTR Correct for incorrect XPT off G9751 ST VWIDTH,@RECLEN Get video screen width INTKB0 ST @CCPPTR,@CCPADR+1 Initialize screen address CLR @CCPADR Clear upper byte CCPADR DADD SCRNBS+1,@CCPADR Add start-addr plus comenstat RTN IOCALL FETCH @FAC12 I/O code to FAC12 (BUG!!!) ST @FAC12,V@COD(@PABPTR) Pick up the I/O code IOCLZ1 CALL CDSR Call the DSR routine BR ERRZ2 Give I/O error on error RTN Or else return * DSR CALL ROUTINE - NORMAL ENTRY CDSR ST OFFSET,V@SCR(@PABPTR) Always set screen offse MOVE 30,@FAC,V@VROAZ Save FAC area DST @PABPTR,@FAC12 Get PAB pointer in FAC DADD NLEN,@FAC12 Get PAB pointer in FAC AND >1F,V@FLG(@PABPTR) Clear error bits for ON ERRO * time, I/O process can still be * continued CALL CALDSR Call actual DSR link routine BYTE 8 MOVE 30,V@VROAZ,@FAC * MOVE does not affect status BS CDSRZ0 ERROR = ERROR = ERROR CLOG >E0,V@FLG(@PABPTR) Set COND if no error CDSRZ0 RTNC * ERROR MESSAGES ERRZ2B CALL CLRFRE Undo allocation of PAB * First check is it error coming from AUTOLD * If it is then do not print the error messege and * go back to TOPL02 ERRZ2 MOVE 2,G@TOPL02,@AUTTMP DCEQ @AUTTMP,@RSTK+2 BR G97A9 ST RSTK+2,@SUBSTK RTN *********************************************************** * Next code is to avoid recursion of errors in CLSALL * routine. If this entry is taken from CLSALL, the stack * will contain CLSLBL as a retrun address in the third leve *********************************************************** G97A9 SUB 4,@SUBSTK DCEQ CLSLBL,*SUBSTK BR G97B8 WRNIO CALL WARNZZ Give warning to the user BYTE 35 * I/O ERROR but warning RTN And return to close routine G97B8 ADD 4,@SUBSTK Back up two levels for OLD/SA ERRIO CALL ERRZZ BYTE 36 * I/O ERROR * ERROR messages called in this file ERRSNM CALL ERRZZ BYTE 7 * STRING-NUMBER MISMATCH ERRIM CALL ERRZZ BYTE 10 * IMAGE ERROR ERRMEM CALL ERRZZ BYTE 11 * MEMORY FULL ERRBV CALL ERRZZ BYTE 30 * BAD VALUE ERRINP CALL ERRZZ BYTE 32 * INPUT ERROR ERRDAT CALL ERRZZ BYTE 33 * DATA ERROR ERRFE CALL ERRZZ BYTE 34 * FILE ERROR ERRPV CALL ERRZZ BYTE 39 * PROTECTION VIOLATION ERRMUV CALL ERRZZ BYTE 9 * IMPROPERLY USED NAME * Other errors called in file * ERRSYN * SYNTAX ERROR BYTE 3 * ERRST * STRING TRUNCATED ERROR BYTE 19 * WRNNPP * NO PROGRAM PRESENT BYTE 29 * WRNINP * INPUT ERROR (WARNING) BYTE 32 * ERRIO * I/O ERROR BYTE 36 * WRNIO * I/O ERROR (WARNING) BYTE 36 * WRNSNM * STRING NO. MISMATCH (WARNING) BYTE 7 *********************************************************** * The following section has been added to fix bugs in INPUT * ACCEPT, and LINPUT statements. *********************************************************** BUG01 CHE >80,@CHAT Make sure of variable name BS ERRSYN XML SYM Get the information of the XML SMB variable. RTN *********************************************************** * GKXB CODE HERE GTLENG ST @CHAT,@FAC+2 Moved from LIST routine ST @XSTLN,V@8(@PABPTR) Store length RTN and return *********************************************************** * RXB ROUTINT TO NOT ALLOW ACCEPT IN EDIT MODE ACCPMM CZ @PRGFLG * EDIT MODE? BR ACCEP2 * No, program mode return XML SCROLL * Scroll screen for error CALL ERRZZ * If imperative - error BYTE 27 * Only legal in a program *********************************************************** CIV254 DCEQ >4956,V@2(@PGMPTR) * IV? BR ERRSYN DCEQ >3235,V@4(@PGMPTR) * 25? BR ERRSYN CEQ >34,V@6(@PGMPTR) * 4? BR ERRSYN CZ @RAMTOP BS SAZ1 DST @RAMTOP,@MNUM Top of memory in ERAM DSUB @STLN,@MNUM Last line of program DINC @MNUM # of bytes total in ERAM DCHE 288,@MNUM * 302 bytes BS GSAVE * IV254 FORMAT BR SAZ1 * PROGRAM FORMAT ************************************************************ END