0000*** TURBO PASCAL version 3.01 A source code
0000***
0000*** commented by Pascal Dornier
0000*** all rights reserved
0000"***
0001"COM file...
0041
0041I/O port equates
0041
0042timer: frequency
0043timer: command
0061"PPI:   sound enable
000F
000Finterrupt numbers
000F
0010BIOS: CRT driver
0016BIOS: KBD driver
0021"MS-DOS entry
0000
0000variable definitions
0000
0001attribute NormVideo
0001attribute LowVideo
0002attribute #2 (used by editor)
0003attribute #3
0004upper left edge current window
0006video mode
0007color or text ?
0008current attribute
0009graphics mode
000Agraphics window: upper left edge
000E  bottom right edge
0012number of loop's for 1 ms
0014line color
0016X direction
0018Y direction
001AX position
001CY position
001EDDA register
0020"graphics: background color
0021heap pointer
0022beginning of heap
0026^ destination pointer
002Asize of entry to delete
002E^ previous entry
0032length of entry to be merged
0034"with next entry
0036CON input buffer
00B6buffer for filename etc.
00CBfor Dir: file attribute
00D4name of file
00E4^ end for formatting
0135"end of buffer
0135I/O vectors
0136KBD stat (ConStPtr)
0138KBD get (ConInPtr)
013ACON put (ConOutPtr)
013CPRN put (LstOutPtr)
013EAUX put (AuxOutPtr)
0140AUX get (AuxInPtr)
0142USR put (UsrOutPtr)
0144"USR get (UsrInPtr)
0145file entries for std files
0146CON, TRM
014AKBD
014ELST
0152AUX
0156USR
015AMS-DOS input file
015Cflag
015E^ buffer
0160buffer size
0166MS-DOS output file
0168flag
016A^ buffer
016C"buffer size
0172option flag - see initmem
0174SP on initialisation
0176CS for return to Turbo
0178DS for return to Turbo
017A^ into list of open files
017Cmax number of open files
017EErrorPtr
0180error number
0181BufLen (for ReadLn)
0182^ into input buffer
0184end of input buffer
0186return address ->
0188position of error
018AHeapPtr: ^ end of heap
018Ebuffer for vector:
0190DIV/0 interrupt
0192code of last key pressed
0194CBreak
0196"buffer for overlay filename
01E6formatting: field size
01E7type of conversion
01E8^ dest string (STR)
01EC^ dest var    (VAL)
01F0^ error var   (VAL)
01F4"real buffer: number to convert
01FAflag: return because of error
01FCrandom seed: last random number
0200string operations: max. length of result
0202Pos
0204Num
0206^ dest string
020A^ object string
020C"
020Ereal arithmetics
020Ffirst number * /
0214second number * /
021Anumber for Sqrt, ArcTan, polynomials
0220sign for + -
0222mantissa + -
0223"
0224real -> ASCII: decimal exponent
0225ASCII -> real: counter for exponent
0226output buffer for result
0232^ current file var
0238function code file operation
0239error code, if failure
023Areal: number to print
0240"table of open files (file handles)
0241kernel variables
0260free memory (paragraphs)
0262stack segment on start
0264stack pointer
0266segment of compiled program
0268code size (paragraphs)
026Adata size (paragraphs)
026Cmin size stack + heap
026Emin size CS
0270min size DS
0272min size free heap
0274max size free heap
0276^ beginning of text
0278^ end of text
027A^ end of text memory
027C^ error in text
027Evector: file too big
0280vector: file not found
02820 = text not translated
0283(0 memory, 1 find error, 2 COM, 3 CHN)
0284compiler's error number
02850 = text not changed
0286number of default drive
0287buffer for filename processing
02C6end of buffer
02C7filename work file
0307filename main file
03470 = work file used
03480 = error messages not read
0349(1 = memory, 2 = COM, 3 = CHN)
034Abuffer: input line for program
0386number output buffer
038E"number current video attribute
038Feditor variables
0390^ block end for search
0392^ block beg for search
0394^ block beg
0396^ block end
0398^ line above
039A^ beginning of text displayed
039Cold position
039E^ end of line
03A0current search pos
03A2search counter
03A4horizontal scrolling
03A5(1 = block beg, 2 = block end in curr line)
03A6cursor position
03A80 = invalid status line
03A9column
03AAFF = attribute changes in curr line
03ABoptions for search
03AB 1=entire words,  2=replace without query
03AB 4=upper = lower, 8=global
03AB10=backwards     20=L (?)
03AC0=search, FF=search and replace
03AD? never referenced !
03AEFF = invisible block
03AFFF = short redisplay
03B0# chars to delete in status line
03B1old length curr line
03B2redisplay from line ...
03B30 = overwrite, FF = insert
03B40 = normal, FF = indent
03B6FF = don't display
03B7redisplay: 0 = small displacement
03BA^ block beg in curr line
03BC^ block end in curr line
03BE^ current line
03C0pos in line buffer
03C2old position for ^QP
03C9(for block transfer)
03CAbuffer for command entry
03CEmax length of search word
03CFlength
03D0string
03EFreplace word
0410options for search / replace
041Dbuffer for filename entry
0461block transfer destination
0463block
0465^ word separator table
0467expected length
04691 = cursor past end of line
046Cbuffer: current line
04EEbuffer for redisplay
0590segment of video memory
0592video row
0593"FF = snowy screen
0593compiler variables
0594SP at start
0596current end of symbol table
0598end of symbol table
059A^ beg symbol table, patch list
059Climit for undefined pointer types
059Elimit for search on new definition
05A0PC of emitted code
05A2data offset of emitted code
05A4space used on stack
05A6^ into code buffer
05A8PC of beg code buffer
05AA^ code buffer
05ACbuffer's offset in file
05ADoffset for overlay
05B0line counter
05B2<> 0: invalid code
05B3number of current record
05B4record counter
05B5enumeration type counter
05B6<> 0: end of source reached
05B7lexical nesting
05B8<> 0: save AX on stack
05B9<> 0: save ES on stack
05BA<> 0: save DI on stack
05BB<> 0: user interrupt used
05BCoverlay counter
05BDFF = include file used
05BFmax number of open files
05C1size of std input buffer
05C3size of std output buffer
05C5compiler directives:
05C5 1 = I/O check
05C5 2 = range check
05C5 4 = I/O mode (CON or TRM)
05C5 8 = value for CBreak
05C510 = user interrupt
05C520 = stack check
05C540 = type check
05C580 = device check
05C7object filename
0607object file handle
0609current end of patch list
060Blimit for patch list
060D^ into text
060F^ beg of source line
0611^ into line buffer
0613variable entry 1:
0615<> 0: indexed var
0616<> 0: indirect via pointer
0617segment (FF=DS, FE=CS, FD=ES, else:
0617lexical nesting
0618variable offset
061Atype
061Celement type
061D<>0: record #, FF: undef pointer
061Elower bound or ^ index type
0620upper bound or ^ element type
0622variable size
0625variable entry 2
062Ctype
062Elower bound
0630upper bound
0632size
0634max size for variant records
0636link for uncrunch list
0638F = VAR parameter
0639number of record variant
063Aprocedure or function
063B<>0: overlay procedure
0647FF = Absolute variable
0648offset
064Asegment
064Cmax length of overlay procedures in a file
064Ebuffer for real constant
0654stack use (WITH, FOR, display)
0655CASE element type
0656directives at beg of statement
0658branch op on comparision
0659flag: Read / ReadLn
065Apointer for FOR: TO / DOWNTO
065CWITH nesting
065Dinline flag
065EWITH table: record number, segment
0660offset, FFFF = indexed
069E^ result type
06A0^ type for comparison
06A2PC before translation of this atom
06A4negation flag
06A6integer constant
06A8buffer for CX
06AAdirectives before include
06ACflag for missing ; error
06ADtype of word read
06AE^ type
06B0^ into symbol table
06B2end of word read
06B4buffer for return address
06B6include filename
06F6include file handle
06F8include pointer
06FAend of include buffer
06FCbeg of line in buffer
06FErelative position in file
0700buffer for patch
0702buffer for word, filename, string...
0782include buffer
0802"beg of text space / error messages
0100"jump to main code
0128ptrs for TINST.COM
016Alower edge of text window
016Fmonochrome attributes
0173mono graphic atts
0177"color graphic atts
017Bput attribute string
017Clength
0181nothing to put
0183next char
0185get it
0187save cnt
0188put CRT
018Canother one ?
018E:yes
0191"
0195"space for timer int vector
0199measure CPU speed
019Fmeasurement value
01A0flag:not done
01A5ptr to timer INT
01ACsave it
01C1INT ok again
01C2"measurement loop
01C4first INT entry
01CAset second vector
01D1clear counter
01D7"do timer routine
01DBsecond INT entry
01DCset flag:done
01E2"do timer routine
01E6wait one step
01EAcount those steps
01EFdone ?
01F4no, continue counting
01F7restore timer INT vec
0206INT ok again
0208number of steps done
020B*2
020D-> result
0210"
0211Delay(BX)
0213DELAY(AX)
0215:no delay
0217delay 1ms
021C"
021DDelay 1 ms
021Eget count for 1ms
0222do it
0224restore cnt
0225"
0226CLRSCR
0227get screen stat
022C= current screen mode ?
0230:ok
0232no: do set it
0235'
0239scroll window up, 0 lines
0240upper left edge
0245lower right edge
024Dclear window
024Fset cursor position
0251upper left edge
0257do it
025A"
025BDelLine
025Fget cursor pos
0262scroll window up
0264one line
026Cupper left edge
0271lower right of window
0279same ?
027B:no
027Dno lines
027Fdo it
0285"
0286InsLine
028Aget cursor pos
028Dscroll window down
028F"as above
0291LowVideo
0292set low attribute
0299"
029ANormVideo, HighVideo
029Bset normal attribute
02A2"
02A3get cursor position
02A5page 0
02A7do it
02A9"
02AAClrEol
02AEget cursor pos
02B1clear window
02B8pos -> upper left
02BBX-position
02BFY-pos from current pos
02C1do it
02C7"
02C8CrtInit
02CBScreen mode
02CCdefined with TINST
02D1do change it
02D4get current screen mode
02D9TextMode
02DEset window
02E3no graphics mode
02E8monochrome ?
02EEptr to screen attributes
02F1:yes, mono
02F6BW80 ?
02F8:yes
02FC:C80, C40, BW40
0302C80 ?
0304:yes
0308C40 ?
030A:yes
030Cmonochrome
0313set screen mode
0316color or mono
031Bset screen size
0320get screen attributes
032Dget screen status
0331correct mode ?
0335:yes
033Aset screen mode
033F"
0342"CrtExit
0343Set cursor position
0344DL=row
0345DH=col
0346pos relative to curr window
034Dadd window pos
0352over edge of screen ?
0356:yes
035D:yes
035Fset cursor
0361page 0
036D"
036E"UpCase
0371WhereX
0374get cursor pos
0376col-window col
037A+1
037E"
037FWhereY
0382get cursor pos
0384row-window row
0388+1
038C"
038DWindow
038ERow 2 - limit to 25
0390:too much
0393set it
0396Col 2
0397limit to 80
0399:too much
039Cset it
039FRow 1
03A1> row 2 ?
03A5: no good
03A9set it
03ACCol 1
03AE> col 2
03B2:no good
03B6set it
03B9"return
03BBTextColor
03BDBlink ?
03BF:no
03C3set blink flag
03CAset new attribute
03CE"
03CFTextBackground
03DAset attribute
03DE"
03DFSet graphic mode
03E0X-size
03E3clear window
03EFY-size = 199
03FAset graph mode
03FEclear background
0402set palette -> backgrnd
0406set foregrnd
040Aset palette
040D"
040EGraphColorMode
0413X-size = 319
0416'set it
0418GraphMode
041D"set it
041FHires
0424X-size = 639
0427set it
042Aset background
042D"
042FGraphBackground
0431get old color
043Astore it
043Dset graph background
0444set palette
0446do it
0449"
044Aset palette AL
044Bget current color
044Fclear palette
0454color graphics ?
0459yes
0461upper bit: part of backgnd
0466set it
046Aset palette
046Cpalette number
0470do it
0473"set backgnd color
0475HiresColor
0476as background
0478set palette
047Ado it
047D"
047EGraphWindow
047Fmax. X = 639
0482Hires ?
0487:yes
0489max. X = 319
048CY2 > 199
048F:no good
0491set Y2
0494X2
0495> max X ?
0497:no good
0499set X2
049CY1
049D>= Y2 ?
04A1:no good
04A3set Y1
04A6X1
04A7>= X2 ?
04AB:no good
04ADset X1
04B0"return
04B2Plot
04B3Y-pos
04B4X-pos
04B5restore return addr
04B6set point, AL is color
04B8test X-pos (do clipping)
04BAnegative: clip it
04BCadd window offset
04C0outside window ?
04C4yes: clip it
04C6test Y-pos
04C8negative: clip it
04CAadd window offset
04CEoutside window ?
04D2yes: clip it
04D5do plot
04D8"
04D9Line. AL is color
04DBset color, command:plot
04DEreturn addr
04DFY2
04E0X2
04E1Y1
04E2store it
04E6calculate direction
04E9store it
04EDABS(AX)
04F0DX:=Y-distance YD
04F1X1
04F2restore ret addr
04F3store X1
04F7calculate direction
04FAstore it
04FEABS(AX)
0501BX:=X-distance XD
0503XD <= YD ?
0505yes:Y-oriented line
0507X-oriented line
050DDDA:=YD+YD-XD
0510XD -> count
0513plot point with clipping
0516test DDA
051B:no step
051DDDA:=DDA+YD+YD-XD-XD
0528Ypos:=Ypos+Ydir
052F'
0531DDA:=DDA+YD+YD;
0538Xpos:=Xpos+Xdir
053Fanother step
0541'
0542Y-oriented line
0548DDA:=XD+XD-YD
054BYD -> count
054Eplot point with clipping
0551test DDA
0556:no step
0558DDA:=DDA+XD+XD-YD-YD
0563Xpos:=Xpos+Xdir
056A'
056CDDA:=DDA+XD+XD
0573Ypos:=Ypos+Ydir
057A:another one
057C"
057Dcalculate direction -> CX
057Fcompare them
0581equal: CX=0
0583:negative
0585positive: CX=1
0586'
0587negative: CX=-1
0588"
0589Set line point with clipping
058Asave count, YD
058Bcolor, command
058EXpos
0592Ypos
0596plot that point
059B"
059CSound
059Efor frequency calculation
05A4frequency < 12 Hz ?
05A6:might damage speaker
05A8calculate timer value
05ACsound on ?
05B0:yes
05B2switch it on
05B6set frequency
05BAset freq lo
05BEset freq hi
05C2"
05C3NoSound
05C5switch it off
05C9"
05CAGetMem, AX=length requested
05CBret addr
05CCdest ptr
05CD"like New
05CFchange representation:
05D0AX=ofs 0..15, BX=seg
05D5seg:=seg+ofs DIV 16
05D9ofs:=ofs MOD 16
05DC"
05DDCompare BX:AX with DX:CX
05E3"
05E4BX:AX + DX:CX -> BX:AX
05E8"change representation
05EAGet length of entry
05F3test if end of heap = 0
05F6"
05F7New
05F8dest ptr
05F9restore ret
05FAsave addr dest ptr
0602number of bytes wanted
0604+7
0607carry ?
060A:yes
060Cno carry
060Espace allocated is n*8
0610convert to seg,ofs
0613needed size
0617last entry
0621get start of heap
0625get len of entry
0628:end of heap
062Asufficient size ?
062D:large enough
062Fremember last entry
0637get next entry
063A'continue searching
063Cstore ES:DI to dest ptr
063Fequal - nothing to crunch
0641calculate superfluous mem
0648'mark the remainder as free
064Aget next entry
064D'set link to it
0656sum up sizes
0659new heap top
0660save size of entry
0662test if heap overflow
0666heap top - stack top
066Dconvert sp
0672compare them
0677:ok
0679'Error FF - memory overflow
067Cmark next entry
067Eas end of heap
0680save length
0682save ptr to next entry
0689try to put together with
068Bnext entry
068Dcalc end of this entry
0690new top
0694now produce that entry
0695link
069Clength
06A3save ES
06A5store ES:DI in last
06A9entry as link to next entry
06B0restore ES
06B1"
06B2store ES:DI in dest ptr
06C0"
06C1FreeMem
06C2ret addr
06C3get ptr
06C4'like Dispose
06C6Dispose
06C7get dest ptr
06C8restore ret
06C9number of bytes
06CCget value of ptr
06D2size+7
06D5carry ?
06D8:yes
06DAno carry
06E1save size of
06E4entry to erase
06E8start at the beginning
06F0= entry to erase ?
06F3:no free space before
06F5get link
06FCcompare with our entry
0701go to next entry
0705'continue
0707ES:DI last entry
0708DX:CX searched one
070AAX:BX current entry
0714store link in disposed entry
071Bstore length
0723restore ES
0725store addr in last entry
072Cget length of this entry
0733try to put them together
0736:end of heap
0738get addr of next one
073Bget length of this entry
0743get link of this entry
074A'try to put them together
074Clink to next entry
0754ptr to this entry
0758store link to next one
075Flink for collect
0763store its len
0770try to merge contiguous entries - thus reducing
0770fragmentation of the heap.
0772length of this entry
0779+ its address
0781convert
0784= next entry ?
0787no:cannot put them together
0789= heap top ?
0793yes:set new, lower heap top
0795save ES
0796addr of next entry
079Aget link to next entry
07A1get length
07A9restore ES
07AAstore link
07B1get length
07B8add them
07BBstore new length
07C5'
07C6set new heap top
07CEclear 8 bytes
07CF= marker for end of heap
07D7restore
07DA"
07DBMemAvail
07DDclear sum
07E1get heap start
07E5get length
07E8:end of heap
07EAsum it up, test size
07EDget next entry
07F0'continue
07F2last entry: free space
07F4between stack and heap
07F6leave some space
07F9convert
07FCclear offset
07FEsubtract heap top
0802:nothing left
0804sum it up
0807space left (paragraphs)
0809"
080Ais it the largest one ?
080C:no
080Eyes, remember its size
0810sum it up
0813remember sum
0817"
0818MaxAvail: do MemAvail
081Bget largest size
081D"
081EMark
081Fget ptr
0820Heap top -> ptr
082E"return
0830Release
0831ptr addr
0832get pointer
0835-> heap top
0839-> heap start
0845clear 8 bytes in entry
0847= marker for end of heap
0851"return
0853Get key stat
0858something there ?
085A:true
085Ctest kbd stat
0860false
0862:nothing available
0864true
0869"
086CGet KBD char
086Fclear last key code
0876:was full - take it
0878get key
087Ctest it
087E:normal char
0880store scan code
0884return ESC
088ABreak !
088CBreak allowed ?
0891:no
0893Break ?
0895:no
0897'
089Aclear hi byte
089C"
089FPrint char to screen
08A0char to be printed
08A1restore ret
08A2save regs
08A5get cursor pos
08A8char to be printed
08A9Carriage Return ?
08AB:no
08ADgo to left margin
08B1'set new pos
08B3Line Feed ?
08B5:no
08B7add 1 to line
08BA>= bottom ?
08BE:no, set pos
08C0'scroll up
08C2Backspace ?
08C4:no
08C6at the left ?
08CAyes, no change
08CCgo back
08CE'set cursor pos
08D0Bell ?
08D2:no
08D4write char
08DA'no pos change
08DCremember position - put char
08DDwrite char
08DFscreen page 0
08E11 char
08E4current attribute
08E8do it
08EArestore pos
08EBgo right one char
08EE= right margin ?
08F2:no, set new pos
08F4go to the left
08F8next line
08FB= bottom ?
08FFno: set pos
0901scroll up
0903save pos
0904scroll up one line
0907att for empty line
090Bposition upper left
0910position lower right
0918do it
091Bset cursor pos
091Dscreen 0
091Fdo it
0922test for break ?
0927:no
092Aget key stat
092D:nothing
0930get key
0933^S ?
0935:no
0938get key
093Brestore char
093C"
093Dput to LST
093Eget char
093Frestore ret
0940operation
0942'do MS-DOS
0944Courtesy of LINK
0945put to AUX
0946get char
0947restore ret
0948operation
094A'do MS-DOS
094DGet from AUX
094Fdo MS-DOS
0952clear hi byte
0954'
0957do MS-DOS-operation
095A:Open file
095F:Create file
0964:Close file
0969:Close all files
096Bsave this
096Erestore it
096F'
0970put file into table of
0971open files, open/create it
0972start of file table
097Aempty ?
097D:yes
0981another one
0983restore regs
0985Error: file not open
0989'
098Aget offset to filename
098Bsave DS
098CES -> DS
098Eopen file
0991restore DS
0992:error
0994file handle -> file list
0996restore
0997"
0998Close file
099Astart of file table
09A2is it this file ?
09A4:no
09A6clear its entry
09AAnext one
09AC:not yet done
09AErestore regs
09B0'do it
09B2Close all files
09BAtest all file handles
09BE:not open
09C0close file
09C2do it
09C5store a 0: closed
09C9next one
09CB:continue
09CD"
09CEInit files, I/O
09D0clear flag
09D3set pt to file tab
09DACX=max number of open files
09DEclear file list
09E0DS -> ES
09E5segment 0:
09E8set vector:
09EEerror handler
09F3measure CPU speed
09F6no test for break
09FBtransfer vectors into table
0A01DS -> ES
0A03CS -> DS
0A05count
0A09move it
0A0Brestore DS
0A0Dclear vars
0A0Fno key stored
0A12no error
0A15no con buf
0A20mark end of buffer
0A25"
0A5A"
0A62"Error handler
0A63put to CON
0A64save registers
0A6Achar to put
0A6Bput it
0A6Frestore regs
0A74"
0A75Get from KBD
0A76save regs
0A7Bdo it
0A7F"restore
0A81Print inline string
0A84return addr -> BX
0A88get char
0A8Ago to next one
0A8Btest it
0A8D0:end
0A8Fput to CRT
0A92'continue
0A94restore ret to pos after text
0A98"
0A99Writeln CRT
0A9Cprint string: CR,LF
0A9F"
0AA0UpCase. < a ?
0AA2:not lower case
0AA4> z ?
0AA6yes:not lower case
0AA8change to upper
0AAA"
0AABWrite Hex number: save it
0AACdo hi byte
0AAEdo it
0AB1restore lo byte
0AB2write hex byte: save low nibble
0AB3get hi nibble
0ABBdo digit
0ABEget lo nibble
0ABFmask it
0AC1convert to hex - tricky
0AC7"now print it
0AC9limit string index
0ACB:ok
0ACDhi <> 0: error
0ACEclear it
0AD1negative:0
0AD3+:255
0AD5"
0AD5Init Memory - with inline parms:
0AD5+ 0:mode flag
0AD5    1=direct mode;    2=no device checking;
0AD5    4=test for break; 8=set breakpoint interrupt
0AD5+ 2:CS for returning to Turbo
0AD5+ 4:DS for returning to Turbo
0AD5+ 6:CS size
0AD5+ 8:DS size
0AD5+ A:heap, stack size
0AD5+ C:max. heap, stack size
0AD5+ E:max. number of open files
0AD5+10:size of std input buffer
0AD5+12:size of std output buffer
0AD6Init memory - with inline parms
0AD9ret addr
0ADAcalculate segments
0ADD+CS size
0AE1+DS size
0AE5+heap, stack size
0AE9> available memory ?
0AED:no
0AEF'Not enough memory
0AF2CS + CS size -> DS
0AFADS + DS size -> beg of free mem
0B03how much is left ?
0B06> max size ?
0B09:no
0B0Climit to max size
0B0FDI: heap size
0B11value for full stack
0B1464 K free ?
0B18:yes
0B1Acalculate stack size -> AX
0B23at beg of heap segment
0B25+ heap segment
0B27-> SS
0B29set SP
0B2Bremember SP
0B2Eclear heap:
0B30ptrs to beg of free memory
0B3Esave heap size
0B3Finit heap:
0B43mark heap top
0B49restore heap size
0B4Areturn excess memory ?
0B4Fdirect mode:no
0B51CS -> ES
0B55Heap pos + Heap size
0B57-> top of used memory
0B59change memory blocks
0B5Bdo MS-DOS
0B5Eset variables
0B5FCS for return
0B66DS for return
0B6Dmain flag
0B70max file count
0B75init files, I/O
0B7Aget end addr
0B7Dof file tab
0B81buffer addr std input
0B86set std in buffer
0B90:no std in file
0B92set handle: std in
0B98clear flag
0B9Dbuffer addr std output
0BA2set std out buffer
0BAA:no std out file
0BACset handle: std out
0BB2clear flag:not open
0BB7set return addr
0BBB0 -> ES
0BBFsave div / 0 interrupt
0BC7div0vec1
0BCDnow set own routine
0BD5div0vec1
0BD9set breakpoint int ?
0BDF:no
0BEDtest for ^C, ^S ?
0BF3:no
0BF5set flag
0BFAset error vec
0C02clear error pos
0C05clear ovrlay pathname
0C08open std in for read
0C13open std out for write
0C1Eclear flag
0C23CrtInit
0C26"
0C27Read Version Number
0C29do MS-DOS
0C2CVersion 0 ?
0C2Eyes:error
0C30'
0C34'
0C39CS -> DS
0C3Bprint string
0C3Ddo MS-DOS
0C43print string
0C45MS-DOS
0C48exit program
0C4A"do MS-DOS
0C75"
0C89End of program
0C8AAX=0:normal
0C8Bclose std input
0C92close std output
0C98restore div / 0 int
0CA7div0int1
0CAAend flag
0CABdirect mode ?
0CB1yes: return to Turbo
0CB3end process
0CB5'return to MS-DOS
0CB8close all files
0CBDset return addr
0CC5DS -> ES
0CCB"return to Turbo
0CCBUncrunch program
0CCBThis routine makes space for overlays, which are not stored
0CCBin the main code file. It makes use of an inline data structure:
0CCB+ 0:length of the block to move
0CCB+ 2:destination addr of this block
0CCBThis makes a list which continues at the end of each block.
0CCCreturn addr
0CCEget block length
0CD00 ?
0CD2yes:end of list
0CD4save DS
0CD5CS -> DS
0CD7CS -> ES
0CD8push list on stack
0CD9count blocks
0CDBget word
0CDDend of list ?
0CDF:yes
0CE1push offset
0CE2add offset
0CE4count entry
0CE5'continue
0CE7last ptr
0CE9get ptr from stack
0CEA+4 -> beginning of block
0CEFget destination addr
0CF2the same ?
0CF6block length
0CF8ptrs to last byte in block
0CFEmove backwards
0D01another block ?
0D02:yes
0D04clear the list: uncrunched
0D08restore DS
0D09skip inline data
0D0C"return
0D0DOverlay header. Inline parameters:
0D0D+ 0:currently valid procedure (ptr into file)
0D0D+ 2:name of the overlay file
0D0D+ F:start of the procedure code
0D0Eget return addr
0D0FDX = file offset of proc wanted
0D10is it already there ?
0D12:no
0D14skip filename
0D17'jump into procedure
0D19AX = overlay length
0D1Asave overlay pos
0D1Bsave dest addr
0D1Cscan overlay pathname
0D1Fclear char buffer
0D21buffer:last char
0D23get char
0D25end of name ?
0D27:yes
0D29next char
0D2A'continue scanning
0D2Csave end pos
0D2Dtest last char
0D2F:no path specified
0D31: ?
0D34:yes
0D36\ ?
0D39:yes
0D3Bstore a \ at the end
0D3Fset to beg of filename
0D41get char from filename
0D44store in pathname
0D47next char
0D48end ?
0D4Ano: continue
0D4Copen file
0D4Fpathname
0D52DS -> ES
0D54do it
0D57file handle
0D59restore parms
0D5Crestore overlay pathname
0D5F:error
0D61store pos as current pos
0D62in the overlay header
0D64seek absolute
0D67pos = DX*256
0D6Fdo it
0D72restore length
0D73:error
0D75read byte block
0D77destination addr
0D7Asave DS
0D7BCS -> DS
0D7Ddo it
0D80restore DS
0D81:error
0D83close file
0D88'jump into procedure
0D8Aerror: Overlay not found
0D8Creturn addr
0D8D"
0D90OvrPath
0D91convert string -> ASCIIZ
0D94restore ret
0D95copy into overlay pathname
0D9BDS -> ES
0D9D64 bytes
0DA3"
0DA4KeyPressed
0DA5check status
0DA9"
0DAAGotoXY
0DABcolumn
0DACrestore ret
0DADrow-1
0DAFcolumn-1
0DB1(Turbo uses origin 1,1)
0DB5"set position
0DB8ParamStr: # wanted string
0DBA0 ?
0DBEsearch in parm line
0DC1string length -> AX
0DC2return addr
0DC3allot space for string
0DC6string dest
0DC8save DS
0DC9CS -> DS
0DCBSS -> ES
0DCDmove string
0DCEstore length
0DCF-> count
0DD0move string
0DD2restore DS
0DD3"return
0DD5ParamCount: count string entries
0DD7parameter line
0DDBlength of param line
0DDFbeginning of string
0DE0clear parm cnt
0DE2:end of line
0DE4search char <> tab, space
0DE5read char
0DE7space ?
0DE9:continue
0DEBtab ?
0DEDno:start of parm
0DEFnext char
0DF0count length
0DF1'continue
0DF3start of parm string
0DF5end of line
0DF7search char = tab, space
0DF8get char
0DFAspace ?
0DFCyes: end of parm
0DFEtab ?
0E00yes: end of parm
0E02next char
0E03count length
0E04'continue searching
0E06end position - beg position
0E0A=0:forget it
0E0Ccount parm
0E0Dsearch another parm ?
0E0E:yes
0E10return count, string length
0E11"
0E12Str(Integer): max length
0E16dest ofs
0E1Aret addr
0E1Bdest seg
0E1Fformat
0E20number
0E21restore ret
0E22save format
0E23dest buffer
0E26Integer -> ASCII
0E29'store in string
0E2BStr(Real): max length
0E2Fdest ofs
0E33ret addr
0E34dest seg
0E38format 2
0E39format 1
0E3Abuffer for real number
0E3Dpop real number
0E45restore ret
0E46format 1
0E47format 2 -> AX
0E48dest buffer
0E4BReal -> ASCII
0E4Eformat
0E4Fptr to dest string
0E53save begin pos
0E54max. field size
0E5Aendposition - buffer pos
0E5B-> length
0E5Emax len - len
0E60:too long
0E62pad with spaces
0E67count len
0E69= max len ?
0E6Byes:done
0E6Dcontinue padding
0E6Fnum len -> CX
0E70source ptr
0E73get char
0E75ptr to next
0E78store in string
0E7Apos = max len ?
0E7Eyes: end it
0E80continue
0E82restore dest ptr
0E84store length
0E86"
0E87Val(Integer)
0E89'
0E8BVal(Real)
0E8Dstore type
0E90pos ofs
0E94ret addr
0E95pos seg
0E99dest ofs
0E9Ddest seg
0EA1get string from stack
0EA4restore ret
0EA5no error
0EAAnull string ?
0EAC:set pos, no change to dest
0EAEinteger ?
0EB2:no
0EB4ASCIIZ -> Integer
0EB7:error
0EB9dest ptr
0EBEstore result
0EC0'get error pos
0EC2real dest
0EC5ASCIIZ -> Real
0EC8:error
0ECCmove real into
0ED0dest var
0ED4no error
0ED6end of buffer reached ?
0ED8:yes
0EDAcalculate error pos
0EDEstore error pos
0EE5"
0EE6get string from stack
0EE9'max 64 chars
0EEBmax 127 chars
0EEEdest buffer (redundant!)
0EF1ret addr
0EF2ptr to string
0EF5get length
0EF9> max length ?
0EFByes, limit it
0EFDtake this length
0F00skip length
0F01dest ptr
0F04DS -> ES
0F06SS -> DS
0F09move string into buffer
0F0Brestore DS
0F0Dstore a 0 at the end
0F10remove string from stack
0F12"return
0F14Randomize: Get time
0F19store as random seed
0F21"
0F22Move var - CX = length
0F23save DS
0F25source ofs
0F27source seg
0F28dest ofs
0F29dest seg
0F2Amove var
0F2Drestore DS
0F2F"return
0F31Copy var -> stack
0F32save DS
0F34source ofs
0F36source seg
0F37make space - CX = len
0F39dest ptr
0F3BSS -> ES
0F3Dmove it
0F40restore DS
0F42"return
0F44FillChar
0F45number of bytes
0F46array ofs
0F47array seg
0F48fill it - char in AL
0F4B"return
0F4DMove: Count -> CX
0F4Esave DS
0F50ret addr
0F51dest ofs
0F52dest seg
0F53source ofs
0F54source seg
0F55forward move
0F56source > dest ?
0F58yes: move forward
0F5Aset ptr to end of block
0F60move backwards
0F61do it
0F63restore DS
0F65"return
0F67Get parms for MsDos, Intr
0F68record seg
0F69save regs
0F6Bsave record addr
0F6Drestore ret
0F6Epointer -> source
0F70source segment
0F73AX value -> stack
0F75BX value
0F78CX value
0F7BDX value
0F7EBP value
0F81SI value -> stack
0F83DI value
0F86DS value
0F88ES value
0F8Bget DS,SI,AX from stack
0F8E"
0F8Fstore register values
0F93stack index
0F95get record ptr
0F98store AX
0F9Astore BX
0F9Dstore CX
0FA0store DX
0FA3store BP (from stack)
0FA5store SI
0FA8store DI (from stack)
0FAAstore DS
0FADstore ES (from stack)
0FAFstore flags (from stack)
0FB1return addr
0FB2clear stack
0FB5restore DS,BP
0FB7"return
0FB9array index check
0FBBAX>=limit CX:error
0FBD'
0FBEIndex out of range
0FC0"
0FC2Range check CX<=AX<=DX
0FC5not enough:error
0FC9too much:error
0FCB'
0FCCScalar or subrange
0FCE"out of range
0FD0Stack check
0FD1CX=space required
0FD3SP-CX
0FD5:error
0FD7getting tight ?
0FDA:yes
0FDCconvert to segment
0FE4compare with heap top
0FE8below:error
0FEA'
0FEBheap / stack collision
0FED"
0FEFBreakpoint interrupt
0FF0return addr
0FF1AX
0FF2Flags
0FF3restore ret
0FF4set flag: int test
0FFAKey pressed ?
0FFD:no
1000get that key
1003restore flag
1008^C ?
100A:yes
100C'
100Dget return addr
1011adjust for length of INT3
1016error: break
1019"
101BIOResult: clear AX
101Dread error, clear it
1021"
1022check for I/O-error
1029'
102Aget error number
102EI/O-error
1030'display message
1032Div/0 interrupt
1033take stuff from stack
1035restore ret
1036div / 0
1038error pos: return addr
103Cruntime error
103Esave error number
103Freinit files, I/O
1042error number
1049store pos of call
104Dbreak ?
104F:yes
1051save error number
1057error handler
105Brestore err number
105CBreak ?
105F:no
1073'
1075set flag: real error
107A:runtime error
1085'
10A0write error number
10A2(hex)
10AEdisplay error pos
10CBProgram end: error
10CD"
10D0"Error handler
10D3Abs(Integer):test sign
10D5:positive, zero
10D7negate it
10D9"
10DARandom(Integer):save limit
10DBdo random
10DEget limit
10DFdiv 2
10E2do modulo
10E4remainder -> AX
10E5"
10E6do random
10EAget seed
10EEsave it
10F0permutate it
1100old seed
1101add it
1106add constant
1110new seed
1118result
111A"
111BInteger -> ASCII
111D:positive number
111Fnegate it
1121store a -
1125flag for leading zeroes
1127digit 10000
112Ddigit 1000
1133digit 100
1139digit 10
113Edo it direct
1140'last digit
1142clear digit
1144do successive subtraction
1146(faster than DIV)
1148:continue
114Arestore remainder
114Cflag:now print zeroes
114Edec number
1150:ok, non-zero
1152clear flag
1156convert to ASCII
1159store
115C"
115DRead integer number:clear result
115F$ ?
1162base 10
1165no:ok
1167base 16
1169go to next char
116Asave previous result
116Bget char
1170save char
1172restore result
1173digit < 0 ?
1176:yes, end of number
1178> 9 ?
117Bno:ok
117Dbase = 16 ?
1180no:end
1182adjust hex
1185< A ?
1188:end
118A> F ?
118D:end
118Fsave base
1190do multiplication
1192restore base
1193:overflow
1195clear hi byte
1197add digit to result
1199:no overflow, continue
119B'end it - overflow
119Dbase 16 ?
11A0:yes
11A2CX:=number*2
11A6"
11A7read integer:test sign
11A9- ?
11AC:no
11AEgo to next char
11AFsave sign
11B0read integer
11B3restore sign
11B4:might be wrong
11B6- ?
11B9:no
11BBnegate it
11BDno error
11BE'
11BF$8000 ?
11C2no:really error
11C4negative ?
11C7no:overflow
11C9'yes:ok
11CAreturn error
11CB"
11CCget string var -> stack
11CDsource seg
11CEsource ofs
11D0get length
11D3-> count
11D5copy length, too
11D6make space on stack
11D8dest: new stack top
11DAsave DS
11DBES -> DS
11DDSS -> ES
11DFmove string to stack
11E2restore DS
11E3"return
11E5inline string -> stack
11E6get length
11E9-> count
11EBcopy length, too
11ECmake space on stack
11EEdest: new stack top
11F0save DS
11F1CS -> DS
11F3SS -> ES
11F5move string to stack
11F6puts SI to end of string
11F8restore DS
11F9"return
11FBstore string from stack
11FCmax. length dest
11FEstack base
1200get length of source string
1205add to stack base
1207+1
1209get dest ptr
120Bsource ptr:stack
120Dtoo long ?
120F:yes
1211take real length
1214store length on stack
1216count
1217save DS
1218SS -> DS
121Amove string
121Drestore DS
121Eremove string, ptr
1221"return
1223store string on stack
1224source seg
1225source ofs
1227CL=length
1229make space on stack
122Cdest addr
122Fstore length
1232save DS
1233ES -> DS
1235SS -> ES
1237move to stack
123Arestore DS
123B"return
123DString insert / delete
123ECL=length
1240string pos
1243get length
1247compare length
1249dest ptr
124B+ difference
124Dtest direction
124F:same length
1251:make it shorter
1253new stack top
1255insert - make string longer
1256get length
1258+1 -> count
1259save DS
125ASS -> DS
125CSS -> ES
125Emove it
1261restore DS
1262'return
1264delete - shorten string
1265store new length
1267go to end of string
126Bcount+1
126Csave DS
126DSS -> DS
126FSS -> ES
1271move it up
1274restore DS
1275beginning of string
1276= new stack top
1278"return
127ACompare strings =
1280equal:true
1282false
1283set flags
1285"
1286Compare strings <>
128Cnot equal:true
1291"
1292Compare strings >=
1298larger or equal:true
129D"
129ECompare strings <=
12A4less or equal:true
12A9"
12AACompare strings >
12B0larger:true
12B5"
12B6Compare strings <
12BCless:true
12C1"
12C2Compare strings
12C4ignore 2 ret addr
12C8get len second string
12CAclr hi byte
12CCptr to beg of string
12CDcalc pos of first string
12CFadd len
12D2get len first string
12D4clr hi byte
12D7calc end pos of string
12D9for removing it
12DBsecond len
12DDfirst len
12DFcompare them
12E1:CX already shorter
12E3shorter len -> CX
12E5null string ?
12E7:yes
12E9save DS
12EASS -> ES
12ECSS -> DS
12EEcompare strings on stack
12F1restore DS
12F2:not equal - flags are set
12F4compare len
12F6return addr
12F7return addr caller
12F8remove strings from stack
12FArestore ret caller
12FB"return
12FDConcat: get return addr
1301pos second string
1304len2
1308go to start of first string
130Elen1
1310len1+len2 too long ?
1312yes:error
1315store new len
1317put first string in front
1319of second
131Bget space on stack
131Dlen1+1; len2 will be overwritten
131Esave DS
131Fsave SI
1320SS -> ES
1322SS -> DS
1324move first string
1327end addr of string 1
1329end pos of concat string
132Cresulting length + 1
1330copy it up
1332restore DS
1334remove garbage from stack
1336'return
133AString too long
133C"
133FCopy: get return addr
1343limit index (length)
1346-> CX
1348string pos
1349check string index
134Cpos in string
134Daddr of string
1350get length
1354pos of dest
1356+ length
1358length > pos ?
135Ano - return null string
135Cbegin pos of substring
135Elength > num ?
1360:yes, sub goes to end
1362pos end of substring
1364new length
1366save DS
1367SS -> ES
1369SS -> DS
136Bmove string
136Erestore DS
136F'return result
1371length = 0
1373point to beg of new string
1376store length
1378remove the rest
137A"return
137ELength
137Fpos of string
1382get length
1384clr hi byte
1386remove string from stack
1389"return
138BPos (search substring)
138Fpos of string
1392length of
1396begin pos of string
1397DI:string scanned
1399go to beg of pattern str
139Cget pattern len
13A0SI:pattern string
13A1calc stack end pos
13A3to remove strings
13A5find position
13A7DX:length difference
13A9pattern too long: not found
13ABpos 1
13ACpattern = null ?
13AEyes: found
13B0number of compares
13B1save DS
13B2SS -> ES
13B4SS -> DS
13B6forward compare
13B7save parms
13BAcompare it
13BCrestore parms
13BF:found
13C1next pos
13C3another search ?
13C4:yes
13C6not found = 0
13C8restore DS
13C9remove strings
13CB"return
13CFInsert: max. dest len
13D3pos
13D6return addr
13D7target string ptr
13DFobject string - on stack
13E7restore ret
13E8target string
13ECsave ptr for storing result
13EEget target string
13EF-> stack
13F2Copy(target,1,pos-1)
13FAdo it
13FDget obj string
1402-> stack
1405concat strings
1408get target string
140D-> stack
1410Copy(target,pos,255)
1417do it
141Aconcat strings
141Dmax. length
1421store string
1424"remove strings
1427Delete: number of chars
142Aret addr
142Bpos in string
142Ftarget string
1437restore ret
1438target string
143Csave ptr for storing result
143Eget target
143F-> stack
1442Copy(target,1,pos-1)
144Ado it
1450pos+num
1454test it
1456too big: nothing left
1458get target
145D-> stack
1460Copy(target,pos+num,255)
1464do it
1467concat strings
146Amax len - never a problem
146Cstore string
146F"
1470String -> char
1471get string
1472test length
1474<> 1:error
1476char -> AL
1478'return
147Astore error position
147EString too long
1480"
1483string -> substring
1485(1 char)
1486length of string
148Cget char
148Fchar
1491length = 1
1494store in string
1497"
1498return string as function result
1499forget DX bytes on stack
149Bpos of string
149Eget its length
14A0= CL (expected length) ?
14A2yes: done
14A6ptr to end of string
14A8destination (must be longer)
14ACend of destination
14AEreal length -> count
14AFcopy length, too
14B0save DS
14B1SS -> DS
14B3SS -> ES
14B5move backwards
14B8restore DS
14BAnew stack top
14BC"return
14BECheck string index
14C0> 255:error
14C40:error
14C6'
14C7Invalid string index
14C9"
14CAGet set. CL=bytes used, CH=bytes empty at beginning
14CCret addr
14CDsource seg
14CEsource ofs
14D0make space on stack
14D3dest ptr
14D5save crunch byte
14D6SS -> ES
14D8forward
14D9empty bytes at beginning
14DB:none
14DDstore zeroes
14E2:another
14E4save DS
14E5DX -> DS
14E8move set
14E9restore DS
14EArestore crunch byte
14EBcalculate empty bytes
14EDat end
14F1:none
14F3store zeroes
14F8:another one
14FA"return
14FCMake empty set
14FD32 bytes on stack
1500dest addr
1502SS -> ES
1504do 32 bytes
1507fill with zeroes
150C"return
150EInclude element: calc index
1512include it
1514"
1515Include range in set
1516ret addr
1517lower; upper is in CX
1518restore ret
1519upper < lower ?
151Dupper-lower -> count
1520save count
1522calc set index (lower)
1525restore count
1527include element in set
152Afor next bit
152C:ok
152Ego to next byte
1531:another element
1533"
1534store set. CX as with load
1537source addr
1539get dest ofs
153Ddest seg
1540# empty bytes
1544add to source addr
1546CL = # bytes used
1548save DS
1549SS -> DS
154Bmove used bytes
154Erestore DS
154F"remove set, pointer
1552Put set as procedure parm
1553bytes empty at beg
1557bytes used
1559source addr
155Bcalc end pos
155Fdest addr
1564= end pos ?
1568go back one byte
156Asave DS
156BSS -> ES
156DSS -> DS
156Eset is stored as compressed
156Flocal var
1571do move it
1572restore DS
1574remove empty space
1576"return
1578Set comparison =
157B'
157DSet comparison <>
157Fset parms
1582compare sets
1584restore DS
1586:equal
1588invert result
158Btest result
158D"remove sets from stack
1590Set comparison >=
1592'
1594Set comparison <=
1597set parms
159A'test type of comparison
159B:<=
159Dswap set1, set2
159Fget byte from set2
15A0include set1
15A2compare with set1
15A3:not the same
15A5:continue
15A7true
15AA'end it
15ACfalse
15AErestore DS
15B0test result
15B2"remove sets from stack
15B5Set union: set parms
15B8get byte set 2
15B9include set 1
15BBstore in set 1
15BC:continue
15BErestore DS
15C0"remove set 2 from stack
15C3Set difference: set parms
15C6get byte set 2
15C7invert it
15C9take it from set 1
15CBstore in set 1
15CC:continue
15CErestore DS
15D0"remove set 2 from stack
15D3Set intersection: set parms
15D6get byte set 2
15D7intersect set 1
15D9store in set 1
15DA:continue
15DCrestore DS
15DE"remove set 2 from stack
15E1Set IN operation
15E3pos of set
15E4get parm
15E7> 255 ?
15E9no: ok
15EBfalse
15ED'return result
15EFcalc set index
15F3test set element
15F5false
15F8not set: false
15FAtrue
15FBtest result
15FD"remove set, parm
1600Calculate set index, mask
1602BX = bit number
1604bit number DIV 8
1608+SP+4 -> set ptr
160Dbit number MOD 8
1612create bit mask
1616"
1617Set parms for set ops
1619ptr set 2
161Cskip two ret addrs
161Eptr set 1
1621save DS
1623SS -> ES
1625SS -> DS
1627count: 32 bytes
162B"
162CCompare pointers DX:AX = CX:BX
162Efalse
1631:not equal
1635:not equal
1637true
1638set flags
163A"
163BCompare pointers <>
163Dtrue
1640not equal: true
1644not equal: true
1646false
1647set flags
1649"
1649*** Real Operations ***
1649#1 #2 register usage
1649AX CX LSB, exponent
1649BX SI mantissa
1649DX DI MSB, sign
164ADo real subtraction
1650'
1652Do real addition
1658second = 0 ?
165A:yes, done
165Cchange sign2, if sub
1660first = 0 ?
1662:no
1664second -> result
166A'
166Bcompare exponents
166DAL <= CL !
166Fotherwhise swap numbers
1674save exp2
1678exponent difference
167Afirst number too small ?
167D:no
167Frestore exp2
1683'second -> result
1685save MSB 2
1689mask out mantissa
168Esave MSB 2
1696remove sign
169Aremove sign
169Dshift first in 16-bit-steps
16A0:done
16A2do it.
16A4first num is shifted to make
16A6exp1 = exp2
16AB'try again
16ADshift first in 8-bit-steps
16B0:done
16B2do it
16BCcount down difference
16BFtest difference
16C1:adjustment done
16C3shift right in 1-bit-steps
16CB:continue
16CDget exp2
16D0test sign
16D5:negative
16D7add mantissa
16DD:ok
16DFdo normalization
16E5inc exponent
16E7:ok
16E9overflow error
16EA'
16EBexchange numbers
16F1subtract numbers
16F7:no underflow
16F9change sign
16FEnegate mantissa
1700= inverted mantissa + 1
170Dnormalize number
170Fupper byte empty ?
1711:no
1713shift left 8 bits
171Dsub 8 from exp
171F:underflow, return 0
1721count down bytes
1723:another one
1725'underflow
1727Mantissa MSB must be 1
172A:yes, done
172Cshift left 1 bit
1732sub 1 from exp
1734:ok
1736underflow, return zero
173C'
173Dclear MSB mantissa
1740set correct sign
1744"
1745Real multiplication: second=0 ?
1747yes: return zero
1749first=0 ?
174Byes: done
174Dadd exponents
174Ftest exponent
1752save first number
175Dclear result
1763ptr to second mantissa
1766do 5 bytes
1768get byte from second mantissa
176B0 ?
176Dno: do multiplication
176Fjust shift result
17718 bits right
1779'next step
177Bdo 8 bits
177Eget bit
1780:not set
1782add mantissa 1 to result
178Eshift result 1 bit right
1794another bit ?
1795:yes
1797another byte ?
1799:yes
179Bsave AX, CL
179Csave flags
179Dalready normalized ?
17A0:yes
17A2restore flags
17A3shift 1 bit left
17A9check exp
17AB:underflow
17ADsub 1 from exp
17AFrestore AX, CL
17B0set sign
17B4test exponent
17B6:ok
17B8return zero
17BE"
17BFReal division
17C1first=0:done
17C3sub exponents
17C6test exponent
17C9save exponent
17CCptr to dest
17CF5 bytes
17D18 bits
17D4compare with num2
17E4below:no subtraction
17E6do subtraction
17F2invert carry
17F3shift into result
17F5another bit ?
17F6:yes
17F8store result byte
17FAanother byte ?
17FC:no
17FEnext one
17FF8 bits again
1802shift left mantissa
1808:normal step
180Acarry: no comparison necessary
180Edo subtraction
1817'shift in result
1819do last shift
181F:ok
1821test last step
1832get result
183Esave flags
183Fnormalized ?
1842:yes
1844get flags
1845shift left mantissa
184B'get sign, test exponent
184Dinc exponent
184F:ok
1851overflow error
1852'
1853"set sign, test exponent
1856test exponent: overflow ?
1858set offset again
185A:ok
185Cforget return addr
185Dreturn zero: underflow
1863'
1864set offset again
1866:no error
1868forget return addr
1869overflow error
186A'
186Bsave LSB2
186Fget sign
1873invert it
1875mask sign
1878save sign
187Cset mantissa MSB
1883store mantissa 2
188B"
188Cadd, keep second number
188Fdo addition
1895"
1896subtract, keep second number
1899do subtraction
189F"
18A0multiply, keep second number
18A3do multiplication
18A9"
18AAdivide, keep second number
18ADdo division
18B3"
18B4Real comparison
18B5compare signs
18B7restore
18B8:signs are the same
18BAdifferent signs: get flag
18BE'
18BFsign ?
18C2:positive
18C4compare
18C7equal: don't invert
18C9invert flags
18CA'
18CBcompare exponents
18CFzero ?
18D1yes:equal
18D3compare mantissa MSB
18DBcompare mantissa LSB
18DD"
18DEInt(Integer) -> Real
18E0:not zero
18E2return zero
18E6'
18E7put sign
18EBtest sign
18ED:positive
18EFnegate number
18F1exp, cleared LSB mantissa
18F4test high byte
18F6:not zero
18F8speed it up...
18FAshift 8 bits
18FCtest mantissa MSB
18FE:ok, normalized
1900count down exponent
1902shift it left
1904:continue
1906negative ?
1908:yes
190Aset positive flag
190Dclear rest of mantissa
190F"
1910Int(Real) - inefficient !
1912exponent too big - done
1914save number
191Aclear mask
1920exponent-offset
1923:underflow, return zero
1925shift 16 bit ?
1928:done
192Ashift right 16 bit
192Eput into mask
1931count down
1934'try again
1936shift 8 bit ?
1939:done
193Bshift right 8 bit
1943put into mask
1945count down
1948shift single bits ?
194A:done
194Cshift in a 1
194Dshift right 1 bit
1953count down
1955:continue shifting
1957get result:
1959mask away the fraction
195D'
195Ereturn zero
1960"
1961Frac - inefficient !
1962save original number
1964Int
1967result -> second number
196Drestore number
1970"do subtraction
1973Load real number onto stack
1974ptr
1976push that number
1980"return
1982Get real constant (inline)
1983get return addr
1984push that number
198Eskip constant
1991"return
1993Store real number
1994get number
1997get dest ptr
1999store number
19A4"return
19A6Add real numbers
19AAsecond number
19ADfirst number
19B0do addition
19B3:error
19B5store result on stack
19B8'return
19BCFloating point overflow
19BE"
19C1Subtract real numbers
19C5second number
19C8first number
19CBdo subtraction
19CE"put result, return
19D0Multiply real numbers
19D4second number
19D7first number
19DAdo multiplication
19DD"put result, return
19DFDivide real numbers
19E3second number
19E6first number
19E9second = 0 ?
19EByes: div / 0 error
19EDdivide
19F0'put result, return
19F2Division by zero attempted
19F4"
19F7Neg real: get addr of number
19FAzero ?
19FE:don't negate
1A01invert sign
1A05"
1A06Abs real: get addr of number
1A09make positive
1A0D"
1A0EReal =
1A12second number
1A15first number
1A18compare real
1A1Brestore ret
1A1Ftrue
1A22equal: true
1A24false
1A25set flags
1A27"
1A28Real <>
1A2Csecond number
1A2Ffirst number
1A32compare real
1A35restore ret
1A39true
1A3Cnot equal: true
1A3Efalse
1A3Fset flags
1A41"
1A42Real >=
1A46second number
1A49first number
1A4Ccompare real
1A4Frestore ret
1A53true
1A56larger or equal: true
1A58false
1A59set flags
1A5B"
1A5CReal <=
1A60second number
1A63first number
1A66compare real
1A69restore ret
1A6Dtrue
1A70smaller or equal: true
1A72false
1A73set flags
1A75"
1A76Real >
1A7Asecond number
1A7Dfirst number
1A80compare real
1A83restore ret
1A87true
1A8Alarger: true
1A8Cfalse
1A8Dset flags
1A8F"
1A90Real <
1A94second number
1A97first number
1A9Acompare real
1A9Drestore ret
1AA1true
1AA4smaller: true
1AA6false
1AA7set flags
1AA9"
1AAASqr real: save ret addr
1AAEget number
1AB1-> second number
1AB7"do real multiplication
1ABAInt real: save ret addr
1ABEget number
1AC1do Int
1AC4"push result
1AC7Frac real: save ret addr
1ACBget number
1ACEdo Frac
1AD1"push result
1AD4Random real
1AD7original exponent
1ADAmax. count
1ADCnormalized ?
1ADF:yes
1AE1shift left 1 bit
1AE5count down exponent
1AE7another bit ?
1AE9:yes
1AEBreturn zero
1AEDclear mantissa MSB
1AF0ret addr
1AF1push result
1AF4"return
1AF6Round
1AF8'
1AFATrunc
1AFCret addr
1AFDget number
1B00restore ret
1B01put exp
1B02subtract exponent
1B04too big ?
1B06:overflow error
1B08too many shifts ?
1B0Byes: 0
1B0Fsave sign
1B11set mantissa MSB
1B14shift right
1B16:nothing to round
1B18round up ?
1B1A:no
1B1Cround it up
1B1Doverflow: error
1B1Fsign ?
1B22:no
1B24negate it
1B26'
1B27return 0
1B29'
1B2AOut of integer range
1B2C"
1B2FInteger -> Real
1B32get ret
1B33push number
1B36"return
1B38Int -> Real
1B3Ckeep second number
1B3Finteger number
1B40do conversion
1B43push result
1B46push second number
1B49"return
1B49Square root. Algorithm: Newton
1B49x[n+1]:=0.5*(x[n]+c/x[n]) -> Sqrt(c)
1B4DSqrt: save ret addr
1B51get number
1B54-> second number
1B5Azero ?
1B5Cyes: return
1B5Etest sign
1B61negative: error
1B63store number
1B6Emake a guess for the
1B71exponent
1B78end condition: difference
1B7Asmaller than this
1B7Dget original number
1B88real division /x[n]
1B8Breal addition +x[n]
1B8E* 0.5 = dec exponent
1B90save x[n+1]
1B92test: end reached ?
1B93real subtraction
1B96test exponent
1B9Arestore x[n+1]
1B9D:not yet done
1B9Freturn result
1BA2'return
1BA6Sqrt argument error
1BA8"
1BAA*** Transcendental functions ***
1BAAThe algorithms used can be looked up in any formulary (!!!)
1BABCos: save ret addr
1BAFget number
1BB2-pi/2
1BBBreal subtraction
1BBE'
1BC0Sin: save ret addr
1BC4get number
1BC7small number ?
1BC9yes: return immediately
1BCB2*pi
1BCEbring into range 0..2*pi
1BD4save sign
1BD5make positive
1BD8real comparison
1BDBrestore sign
1BDC:ok
1BDEreal division, keep 2*pi
1BE1save 2*pi
1BE4Frac
1BE7restore 2*pi
1BEAreal mult, keep 2*pi
1BEDnegative ?
1BF0:no
1BF2add 2*pi
1BF5change to pi
1BF7real comparison
1BFAsave result
1BFB:below
1BFDsubtract pi
1C00change to pi/2
1C02real comparison
1C05:less
1C09add -pi
1C0Fsmall number ?
1C11yes:return
1C13pointer to constants
1C167 numbers
1C19do polynome
1C1Cflag: >pi
1C1D:ok
1C1Fneg, if not zero
1C21:zero
1C23negate
1C26"push result
1C29-1/15! constants for sin,cos
1C2F 1/13!
1C35-1/11!
1C3B 1/ 9!
1C41-1/ 7!
1C47 1/ 5!
1C4D"-1/ 3!
1C53Ln (Logarithm)
1C57get number
1C5Azero ?
1C5Cyes:error
1C5Enegative ?
1C61:no
1C63Ln argument error
1C65'
1C68sign, LSB
1C6Abring into range 1..2
1C6Cmodify exponent
1C6Finteger: exponent
1C70set new exponent
1C71multiply *Sqrt(2)/2
1C7Amultiplication
1C7Dfirst -> second number
1C83first number = 1
1C8Aaddition +1
1C8Dsave result
1C90first = -1
1C98addition -1
1C9Brestore result
1C9Edivision (c-1)/(c+1)
1CA1pointer to constants
1CA46 numbers
1CA7do polynome
1CAAresult *2
1CAC+ ln(sqrt(2))
1CB5addition
1CB8get int exponent
1CB9save result
1CBCexponent
1CBD-> real
1CC0* ln(2)
1CC9multiplication
1CCCrestore result
1CCFadd
1CD2do a cosmetic round-off (!!!)
1CD4:no
1CD6return zero
1CDC"push result
1CDF1/13 Constants for Ln
1CE51/11
1CEB1/ 9
1CF11/ 7
1CF71/ 5
1CFD"1/ 3
1D03Exp: get return addr
1D07get number
1D0Anegative ?
1D0Dremember flag
1D0Emake it positive
1D11/ln(2)
1D17(would be faster to use mult !)
1D1Adivision
1D1Dtoo much ?
1D1F:yes, overflow
1D21save number
1D24* 2
1D28do Round
1D2Brestore number
1D2Esave integer part
1D2Fconvert -> real
1D32zero ?
1D34:yes
1D36/ 2
1D38swap them
1D3Dsubtraction -> frac
1D40ptr to constants
1D438 numbers
1D46do polynome
1D49get exponent
1D4A/ 2
1D4C:even
1D4Esave it
1D4F* Sqrt(2)
1D58multiplication
1D5Brestore exponent
1D5Cadd exponents
1D5E:overflow error
1D60restore sign
1D61pos: store result
1D63negative: do 1/x -> x
1D65first -> second
1D69first = 1
1D70division
1D73'push result
1D76clear stack
1D77Floating point overflow
1D79"
1D7Cln(2)**8/8! Constants for Exp
1D82ln(2)**7/7!
1D88ln(2)**6/6!
1D8Eln(2)**5/5!
1D94ln(2)**4/4!
1D9Aln(2)**3/3!
1DA0ln(2)**2/2!
1DA6"ln(2)
1DACArcTan: get ret addr
1DB0get number
1DB3zero ?
1DB5yes: return
1DB7clear neg flag
1DB9negative ?
1DBC:no
1DBEset neg flag
1DBFmake positive
1DC2save neg flag
1DC3second = 1
1DCAreal comparison
1DCD:x < 1
1DCFswap numbers
1DD4division x -> 1/x
1DD7restore neg flag
1DD8set bits: large number
1DDApush it again
1DDB> 0.1371 ?
1DE4real comparison
1DE7:yes
1DE9do polynome
1DEC'complete result
1DEEpointer into table
1DF4save index
1DF5save ptr
1DF6test different ranges
1DF7get table entry
1E01real comparison
1E04restore
1E06:smaller than that
1E08go to next entry
1E0B:another one
1E0Dsave space in table
1E10go to associated number
1E13save number
1E1Esave ptr
1E1Fget number from table
1E2Asubtraction x-t
1E2Dsave number
1E30restore x
1E3Bx*t
1E3Esecond = 1
1E45addition
1E48first -> second
1E4Erestore x-t
1E51division -> (x-t)/(x*t+1)
1E54do polynome
1E57restore ptr
1E5Cget number
1E66add it
1E69get flag
1E6Adone 1/x ?
1E6D:no
1E6Fsave flag
1E70first -> second
1E76first = pi/2
1E7Fsubtraction pi/2-y
1E82restore flag
1E83negative ?
1E86:no
1E88set sign
1E8B"push result
1E8E1. tan(22.5) range table
1E94   tan(15)   for ArcTan
1E9A   15
1EA02. tan(37.5)
1EA6   tan(30)
1EAC   30
1EB23. tan(45)
1EB8"   45
1EBE-1/11 constants for ArcTan
1EC4 1/ 9
1ECA-1/ 7
1ED0 1/ 5
1ED6" 1/ 3
1EDCptr to ArcTan constants
1EDF5 of them
1EE2do polynome: store number
1EE3y:=x+c*x**3+b*x**5+a*x**7...
1EE5save cnt
1EE6save ptr
1EE7first -> second
1EEDmultiplication -> square
1EF0restore cnt,ptr
1EF2do polynome 2
1EF5get number -> second
1EF8"multiplication
1EFBdo polynome 2: store number
1EFEy:=1+c*x+b*x**2+a*x**3...
1F06get number from table
1F11save ptr, cnt
1F13'start it
1F15save ptr, cnt
1F18get number from table
1F22add it
1F25get x -> second
1F31multiplication *x
1F34restore ptr, cnt
1F36go to next number
1F39:another one
1F3Bsecond = 1
1F42"add 1
1F45Format real number
1F46number of fraction chars
1F49< 25:ok
1F4Bfield width
1F4Dlimit it
1F52negative (DI:ptr to num)
1F56:no
1F58one char more
1F5C:no underflow
1F5Enegative: make zero
1F60limit to 9
1F66-> number of fraction chars
1F6Csave # fraction chars
1F6Dconvert to decimal
1F70restore
1F73number of mantissa chars
1F7Dmark end of buffer
1F82'
1F84max 11 digits shown
1F86:ok
1F88limit it
1F8Around up number
1F8Ddest ptr
1F8Esource: dec buffer
1F91test sign
1F94:no
1F96put a -
1F9Bexponent: number of int digs
1F9Dsize of number
1F9F:zero
1FA3neg exponent ?
1FA5:no
1FA7store 0 - no int part
1FAA'do fraction part
1FACput char from source
1FAFanother one ?
1FB1:yes
1FB3test fraction len
1FB5:nothing
1FB7put a .
1FBCput zeroes as necessary
1FBE:exponent ok
1FC0put a 0
1FC3field filled ?
1FC5:no
1FC7another fraction digit ?
1FC9:no
1FCBdo digit
1FCE'next one
1FD0do exponent ?
1FD2:yes
1FD4'
1FD5put an E
1FDA+
1FDCtest sign
1FDE:positive
1FE0negate exponent
1FE2-
1FE4store sign
1FE7do DIV 10 / MOD 10
1FE9count up digit
1FEBsuccessive subtraction
1FEE:continue
1FF0put digit
1FF3restore second digit
1FF6put digit
1FF8"
1FFAget digit from source
1FFCend ?
1FFE:yes
2000ptr to next char
2001'store digit
2003store a 0
2005store digit
2007ptr to next dest char
2008"
2009Real -> Decimal
200Bget real number (in CS !)
2011zero ?
2013:no
2015fill buffer with zeroes
201Eend reached ?
2022:no
2024exponent 0
2027'
2028get sign
202Aclear sign in mantissa
202Dsave exp
202Esave mantissa
202Fexponent
2032* 77
203577/256 is about ln(2)/ln(10) !
2037+5
203Athis is approx. dec exponent
203Crestore
203Ecorrect error
2041:ok
2045save exponent, sign
2046negate exponent
2048bring into range
204Brestore
204Cexp ok ?
204E:yes
2050mult * 10
2053count down dec exp
2055save exp, sign
2056set mantissa MSB
2059offset for exponent
205DLSB = 0
205F:no shift
2061convert to 6-byte-card
2067shift again ?
2069:yes
206Bptr to output buffer
206Eget upper 4 bits
2074-> digit
2077store digit
2079clear that digit
207Ccard * 10 -> card
207Dsave number
207Fcard * 4
208B+ card
2094* 2 = card * 10
209Anext buffer pos
209Bdone ?
209F:no
20A1restore exp, sign
20A2"
20A3Round up decimal number
20A5ptr to buffer
20A8add digit index
20AA5 ?
20ADstore 0: end mark
20B0below: no round up
20B2go back one digit
20B4:beg of buffer reached
20B6go back one pos
20B7inc that digit
20B9carry ?
20BCno: done
20BEmark as end
20C1'continue
20C3store a 1
20C6end mark
20CAinc exponent
20CC"
20CDString -> Real
20CF- ?
20D2:no
20D4next char
20D5save sign
20D6convert unsigned real
20D9restore sign
20DA:error
20DC- ?
20DF:no
20E1result = 0 ?
20E6negate it
20EAno error
20EB"
20ECsource ptr
20EEASCII -> unsigned real
20F0clear result
20F6exponent
20FBget char
20FDlower case ?
2100:no
2105:no
2107convert to upper case
210Ado a digit
210D:no digit
210Fresult * 10
2112:overflow
2114save ptrs
2117save result
211Aget digit
211Cclear hi byte
211Econvert to real
2121restore result
2124add digit to result
2127restore ptrs
212Aafter decimal point ?
212D:yes
212Fcount down exponent
2133'next digit
2135decimal point ?
2138:no, test exponent
213A. already done ?
213Derror
213Eyes: error
2140set flag
2143next char
2144'continue
2146pointer: end pos
2148'
2149E ?
214Cexponent
2150:no
2152bring into range
2155:error
2157go to next char
2158get it
215A+ ?
215D:yes
215F- ?
2162no: digit
2164set flag: neg exponent
2167next char
2168do digit
216B:error
216Dsave
216Efirst digit
2170next char
2171do digit
2174:no second digit
2176AL*10 -> AL
2182next char
2183new exponent
2185restore
2186negative exponent ?
2189:no
218Bnegate it
218Dreal number*10**exp
2190store the result
2198"set pointer to end
219Aoutside a reasonable range ?
219D:yes
21A2:yes
21A4save pointers
21A7bring into range
21AD'
21AEerror
21AF"
21B0get digit
21B2< 0 ?
21B5:yes
21B7> 9 ?
21BAchange to error flag
21BB:yes
21BDconvert to number
21C0"
21C1bring into range:
21C2number*10**CL
21C3save number
21C4save exponent
21C8negative ?
21CA:no
21CCmake it positive
21CE(exponent DIV 4)*6
21D7-> pointer into table
21D9clear hi
21DBfactor table
21E0get factor
21EAexponent MOD 4
21ED:ok
21EFdo successive multiplications
21F2another ?
21F4:yes
21F6factor -> second
21FCrestore number
21FFpositive exponent ?
2204:no
2206'multiply num*factor
2209"divide num/factor
220Cdecimal factor table
2242"
2248Real multiplication * 10
224A:not zero
224C'zero - return
224Dset mantissa MSB
2250save CX
2251save number
2254mantissa / 4
2260add mantissa
2261why no ADC (rounding !) ?
2269restore CX
226Cshift right
2272exponent+1
2274:ok
2276overflow...
2277'
2278make positive
227Bexponent+3
227D"
227EReal -> long cardinal
227F2 ret addrs
2280get real
2283restore rets
2285negative ?
2288yes:return zero
228Aset mantissa MSB
228Dexponent offset
228Fcalc number of shifts
2291:too much
2293too small ?
2295:return zero
2297another shift ?
2299:done
229Bshift right: denormalize
22A1'next one
22A3return number in DX:AX
22A7'
22A8return zero
22AC'
22ADreturn maxcard
22B3"
22B4long cardinal -> real
22B80 ?
22BAyes: return 0
22BCexponent, LSB mantissa
22BFnormalized ?
22C2:yes
22C4shift left
22C8count down exponent
22CA'continue
22CCmake positive
22CFreturn addr
22D0push result
22D3"return
22D5text file
22D7do assign: store func code
22DAret addr
22DBstring -> ASCIIZ
22DEptr to file var
22E0restore ret
22E1file var in DS ?
22E9std in / out file ?
22ED:yes, error
22EFsave var ofs
22F0path name buffer
22F3path name in file var
22F6copy 64 chars
22FBdo it
22FCrestore file var ofs
22FDtest if device
2300:yes
2302flag: not open
2304no handle
2308store file handle
230Atext file ?
230F:no
2312set file flag
2315set buffer ofs
2319store in file var
231C'
231Dset file var:
231Erecord length
2323'
2324Assign to std files
2329"not allowed
232AReset text file
232C'
232ERewrite text file
2330'
2332Append text file
2334store function code
2337get ret addr
233Bfile var ptr
233Crestore ret
2341test flag
2344device ?
2346:no
2349clear flag: char preread
234D'
234Fstore buffer size
2352close file
2355error ?
235Ayes:ret
235Cdo open file
235Ferror ?
2364yes:ret
2366do device checking ?
236C:no
236Etest device status
2372get file handle
2374do it
2377device ?
237B:no
237Ebuffer len: 1 char
2383read ?
2388:no
238Bopen for input
2390buffer pos
2394-> buffer ptr
2398-> buffer end
239B'
239Cwrite: prepare for output
239Eseek relative to EOF
23A2file handle
23A4offset 0
23A8do it: get file length
23ACbuffer size
23AF< 128 ?
23B3yes: ok
23B5go back up to 128 bytes
23B8sub from file pos
23BD:ok
23BFbeyond beg of file -
23C1go to beg of file
23C7save char count
23C8dest pos
23CCseek absolute
23D0file handle
23D2do seek
23D5read from buffer
23D8counter
23DCbuffer ptr
23E0search ^Z
23E3:found
23E5next char
23E7:continue
23E9'EOF not found
23EBseek from end
23EEDX = offset from end
23EFfile handle
23F1backwards
23F4do seek
23F7prepare for subsequent output
23F8open for output
23FDbuffer offset
2401-> buffer ptr
2405+ buffer size
2409-> buffer end
240C"
240DTruncate text file
2411file var ptr
2412restore ret
2417open for input ?
241B:no - ret
241Ebuffer ptr
2422- buffer end
2425equal: ok
2427seek relative
242Bfile handle
242Dbackwards
2430do it
2433write
2436file handle
2438len = 0 -> truncate
243Ado it
243D"prepare for output
243FFlush
2443file var ptr
2444restore ret
2449output file ?
244Dno: ret
244F'flush buffer
2452"
2453Close text file
2457get file var pt
2458restore ret
245Dget flags
2460device ?
2462yes: ret
2464flush the buffer
2468clear flag
246Dfile handle
246Fstandard file ?
2472:ret
2474not open ?
2477yes:ret
247Aclear file handle
247Eclose file
2480do it
2483:ok, no error
2485file disappeared
248A"
248BTest filename for device
2491save cnt, ptr
2493file name
24963 chars
2499get char
249Bignore upper / lower
249Fcompare
24A1:ok
24A3restore cnt, ptr
24A5next device
24A8another one ?
24AAnot found
24AB'
24ACnext char
24AE:another char
24B0remove
24B2next char = : ?
24B5:no device
24B8get flag
24BBget file handle
24BE"
24BFDevice table
24C2input, output, dev 1
24C8input, output, dev 1
24CEinput, dev 2
24D4output, dev 3
24DAinput, output, dev 4
24E0input, output, dev 5
24E3std MS-DOS input-file
24E6not open, handle 0
24E9std MS-DOS output-file
24ECnot open, handle 1
24EFstd MS-DOS error file
24F2"not open, handle 2
24F5do open file
24F6handle <> $ffff ?
24F9yes: already open
24FBopen for input / output
24FEerror number
2500create file ?
2505:no
2507create
2509clear attribute
250Berror (dir full)
250Dsave error number
250Eptr to path name
2511do it
2514restore error number
2515:error
2518store file handle
251A'
251Bstore error number
251Ftoo many open files ?
2521:no
2523set that error
2528"
2529Set standard input
252Dptr to file var
2537"return - error pos set
253Bprepare for read
253Fget file var ptr
2540-> current file
2549open for input ?
254D:yes
254Ferror: not open for input
2554"return
2558Set standard output
255Cptr to file var
2566"return
256Aprepare for write
256Eget file var ptr
256F-> current file
2578open for output ?
257C:no
257Eerror: not open for output
2583"return
2587Readln string
2589'
258BRead string
258Dget ret addr
2591from std input
259Bclear flag: char read
25A0save dest var ptr
25A2save flag
25A3read with editing
25A6restore flag
25A7readln ?
25A9:no
25ABdo WriteLn
25AErestore dest var ptr
25B0"return
25B4Read line with editing: clr flag
25B6buffer length
25BAtoo big ?
25BD:no
25BFlimit to 127 chars
25C1127 chars again
25C9set input ptr
25CDptr into line
25CFget char
25D2flag: one char
25D4BS ?
25D6:yes
25D8Delete ?
25DA:yes
25DC^D ?
25DEyes, recall char from buffer
25E0flag: all chars
25E2^X ?
25E4yes:erase input line
25E6ESC ?
25E8yes:erase input line
25EA^R ?
25ECyes:recall last input line
25EE^Z ?
25F0:yes
25F2CR ?
25F4:yes
25F6other control char ?
25F8yes: ignore
25FAend of buffer reached ?
25FEget old char
2600store new char
2602new pos
2605was it old end of buffer ?
2608:no
260Amark it again
260Cdisplay new char
260F'next key
2611go back one char
2613:beg of line
2615go back one char
261Cgo back
261Danother char ?
261F:yes
2621'next key
2623recall from buffer
2625end of buffer
2627:yes
2629display that char
262Cnext one
262Fanother one ?
2631:yes
2633'next key
2635test flag
2637:no EOF allowed
2639'store it
263Btest flag
263D:no ^Z needed
263Fstore ^Z
2642'end it
2644WriteLn
2647store CR,LF at end
264B2 chars added
264C1 char added
264Dstore end pointer
2651"
2652Put char: save break flag
2656break allowed
265Bsave flag
265Cprint char
265Frestore flag
2664"
2665Get byte from current file
2669error ?
266Eyes: return ^Z
2671test flags:
2674char pre-read ?
2676yes: return it
2678device ?
267A:yes
267Dbuffer pointer
2681= buffer end ?
2684:no
2686read buffer
268Abuffer ptr
268Eget byte
2690advance ptr
2692store ptr
2695'remember that char
2697save file ptr
2698test devices
2699CON ?
269B:no
269Dget from CON input buffer
26A1end of buffer reached ?
26A5no: return char
26A7^Z allowed
26A9read line
26ACptr to char
26B0get char
26B2advance ptr
26B3update ptr
26B7'done
26B9KBD ?
26BB:no
26BD(function:char)
26BEget char
26C2'return it
26C4AUX ?
26C6:no
26C9get char
26CD'return it
26CFUSR
26D0get char
26D4restore file var ptr
26D7store char in buffer
26DBset flag: char pre-read
26DF'
26E1get char from buffer
26E4'
26E5return ^Z = EOF
26E7'
26E8read buffer
26EBfile handle
26EEbuffer size
26F2buffer offset
26F5save DS
26F6ES -> DS
26F8do it
26FBrestore DS
26FC:no error
26FEnothing read
2701buffer offset
2704anything read ?
2706:yes
2709store a ^Z
270C1 char read
270E-> buffer pointer
2711+ number chars read
2714-> buffer end
2717"
2718Read number
2719save ptr
271Abuffer ptr
271Dsave
271Eget char
2721restore ptr
2722^Z ?
2724yes: end
2727clear flag: char pre-read
272Bspace / control ?
272Dyes: ignore
272Fstore that char
2731advance ptr
2732end reached ?
2736:yes
2738save ptr
2739get char
273Crestore ptr
273Dspace / control ?
273Fyes: end
2742clear flag: char pre-read
2746'next digit
2748store a 0 at the end
274Bnothing entered ?
2751restore ptr
2753"
2754Check numeric format
2756end reached ?
2759yes: ok
275BError in numeric format
2761"
2762Read char: save ptr
2763get char
2767clear flag: char pre-read
276Bvar ofs
276Cret addr
276Dvar seg
276Fstore char
2771"return
2773Read byte
2774'
2776Read integer
2777ret addr
2778dest seg
2779restore ret
277Asave flag
277Bread number.
277E:nothing entered
2780convert to integer
2783check numeric format
2786:error
2788restore flag
2789:byte
278Cstore integer
278E'
2790store byte
2792'
2793remove flag
2794"error - don't change var
2795Read real
2796dest seg
2797restore ret
2798read number
279B:nothing entered
279Dsave dest ptr
279Fdest var
27A2convert to real
27A5-> source ptr
27A7restore dest ptr
27A9check numeric format
27AC:error
27AEstore real number
27B2"
27B3Read string var
27B4dest seg
27B5restore ret
27B6clear length of string
27B8count. CL=max len
27BAsave dest ptr
27BCsave len, cnt
27BEget char
27C1restore
27C3CR ?
27C5:end
27C7^Z ?
27C9:end
27CCclear flag: char pre-read
27D0restore dest ptr
27D2count len
27D4store char
27D6:another char
27D8'store length
27DArestore dest ptr
27DDstore length
27DF"
27E0Read array of char
27E1dest ptr
27E2restore ret
27E3CL=max len
27E5save dest ptr
27E7save cnt
27E8get a char
27EBrestore cnt
27EDCR ?
27EFyes: end
27F1^Z ?
27F3:yes
27F6clear flag: char pre-read
27FArestore dest ptr
27FCstore char
27FD:another char
27FF'
2800restore dest ptr
2802pad with spaces
2806"
2807Readln: get char
280A^Z ?
280Cyes: done
280Fclear flag: char pre-read
2813LF ?
2815yes: done
2817CR ?
2819no: continue
281Bget next char
281ELF ?
2820no: forget it
2823clear flag: char pre-read
2827"
2828put char to current file
282Cerror ?
2831yes: no output
2834get flag
2837device ?
283A:yes
283Dget buffer pointer
2841store char
2843advance pointer
2845update pointer
2849= buffer end ?
284Cyes: do flush
284E'
284Fput char as parameter
2850CON ?
2853:yes
2855LST ?
2858:yes
285AAUX ?
285D:yes
285FUSR out
2863'
2864CON out
2868'
2869LST out
286D'
286EAUX out
2872'
2873flush output buffer
2874count=pointer-offset
287B:nothing to write
287Dwrite byte block
2880file handle
2883buffer offset
2887reset buffer pointer
288Asave DS
288BES -> DS
288Ddo it
2890restore DS
2891:error
2893length = expected ?
2895:yes
2897Disk write error
289C"
289DWrite char
289FAX=formatting parm: nothing
28A1limit it
28A4<= 1 char ?
28A8-> count
28A9-1 for char itself
28AAput spaces
28ACsave count
28ADput it
28B0restore count
28B1:continue
28B3ret addr
28B4get char
28B5restore ret
28B6"put that char
28B9Write integer: format parm
28BAreturn addr
28BBget number
28BCrestore ret
28BDsave format parm
28BEdest buffer
28C1Integer -> ASCII
28C4restore format parm
28C5limit it
28C8calc length
28CClength of spaces ?
28CE:no space left
28D0-> count
28D1save number length
28D2put spaces
28D4save count
28D5put it
28D8restore count
28D9:another space
28DBrestore number length
28DC-> count
28DEbuffer ptr
28E1get char
28E3save ptr, cnt
28E5put it
28E8restore
28EAnext char
28EB:again
28ED"
28EEWrite real: second format parm
28EFret addr
28F0first format parm
28F1get number from stack
28FCrestore ret
28FDpush format parm
28FEdest buffer
2901Real -> ASCII
2904"write buffer
2906write boolean
2907get boolean
2908restore ret
2909(true)
290Ctest boolean
290E:true
2910(false)
2913str segment
2914load string
2917write string
291A"
2920"
2926Write string: format parm
2929pos of string
292Bskip ret addr
292Efield len - string len
2930:too much - no padding
2932-> count
2936save string pos
2937put spaces
2939save count
293Aput it
293Drestore count
293E:another space
2940restore string pos
2942get length
2944-> count
2946point to first char
2947nothing to write ?
2949:yes
294Cget char
294Esave ptr, cnt
2950put char
2953restore
2955next char
2956:another
2958ret addr
2959remove string from stack
295B"return
295DWrite inline string
295Fget length
2961-> count
2963point to first char
2964:null string
2967get char
2969save
296Bput char
296Frestore
2970next char
2971:another
2973"return - text skipped
2975WriteLn
2977put CR
297C"put LF
297FSeekEOLN
2982'
2984EOLN
2987'
2989SEEKEOF
298C'
298EEOF
2991get return addr
2995file var seg
2996restore ret
299Bopen for input ?
299Fno: false
29A1save flag
29A2get char from file
29A5restore flag
29A6= char searched ?
29A8yes: true
29AAEOF ?
29ACyes: true
29AEspace / control ?
29B0no: false
29B2seek it ?
29B4:no, false
29B7clear flag: char pre-read
29BB'search it
29BDreturn true
29BFsetting flags
29C0'
29C1return false
29C3"
29C4Assign: set function code
29C6"do assign
29C9Reset typed
29CB'
29CDRewrite typed
29CFstore function code
29D2get return addr
29D6file var ptr
29D7restore ret
29DBsave record length
29DCclear record len, close file
29DFremove for error exit
29E0error ?
29E5:yes
29E8open that file
29EBrecord len
29ECerror ?
29F1:yes
29F4store record length
29F7"
29F8Truncate typed, untyped
29FCfile var ptr
29FDrestore ret
2A01write
2A04file handle
2A06length = 0 -> truncate
2A08"do it
2A0B"Flush typed, untyped
2A0EClose typed, untyped
2A12file var ptr
2A13restore ret
2A18record len = 0
2A1D"close it
2A20Select file
2A24file var ptr
2A25-> current file
2A2Erecord len = 0 ?
2A32no: ok
2A34File not open
2A39"ret
2A3DRead from typed file
2A43'read, unexpected EOF
2A45Write to typed file
2A4Bwrite, disk write error
2A4Cvar seg
2A4Drestore ret
2A4Eerror ?
2A53yes: no operation
2A55save DI
2A57current file var
2A5Bsave function, error code
2A60file handle
2A63record length
2A66save DS
2A67ptr var
2A69do it
2A6Crestore DS
2A6D:error
2A6Flength = expected ?
2A71:yes
2A73read ?
2A78no: error
2A7Atest count
2A7Cnothing done: error
2A7Frecord length
2A82restore dest ofs
2A84add count read
2A86dest seg
2A88count to fill
2A8Apad with zeroes
2A8Ddo fill
2A8F'
2A90error code -> error
2A96"
2A97Seek: clear high word
2A99set error pos
2A9Dget file var ptr
2A9Frestore ret
2AA4get record length
2AA7* pos -> DX:AX
2AAA-> CX:DX
2AAEseek absolute
2AB2file handle
2AB4save pos wanted
2AB6do it
2AB9restore pos wanted
2ABB:error
2ABDpos = expected ?
2ABF:no
2AC3:yes
2AC5Seek beyond EOF
2ACA"
2ACBLongSeek: convert real
2ACE"do it
2AD0EOF typed, untyped
2AD1get file var ptr
2AD2restore ret
2AD3get unit status
2AD7file handle
2AD9do it
2ADCtest result
2ADEfalse
2AE1:ok
2AE3true
2AE4set flags
2AE6"
2AE7FilePos: ret addr
2AE8file var ptr
2AE9restore ret
2AEAseek relative
2AEEfile handle
2AF0no offset
2AF4get position
2AF8record length
2AFB"pos / reclen -> filepos
2AFDLongFilePos
2AFEreturn addr
2AFFfile var ptr
2B00restore ret
2B01do it
2B04"result -> real
2B07FileSize: ret addr
2B08file var ptr
2B09restore ret
2B0Aseek relative
2B0Efile handle
2B10no offset
2B14get current pos
2B17save it
2B19seek from end
2B1Dfile handle
2B1Fno offset
2B23get end position
2B26restore current pos
2B28save end pos
2B2Arestore file pos
2B2Cseek absolute
2B30file handle
2B32go back to old pos
2B35end position
2B38(pos+reclen-1)
2B41"/ reclen -> position
2B43LongFileSize: ret addr
2B44file var ptr
2B45restore ret
2B46do it
2B49"result -> real
2B4Clong cardinal division
2B4F/ 1: done
2B51DX:AX / CX -> DX:AX
2B53clear result
2B5532 bits
2B58shift in result
2B5Atry subtraction
2B5C:ok
2B5Erestore it
2B61make flag to shift in
2B62shift in result
2B66:another bit
2B68"
2B69long card mul
2B6BDX:AX * CX -> DX:AX
2B6Dhigher word
2B6Fsave it
2B70lower word
2B72add higher result
2B74"
2B75Reset untyped: record length
2B76ret addr
2B77file var ofs
2B78restore ret
2B79"now like typed file
2B7CRewrite untyped: record length
2B7Dret addr
2B7Efile var ofs
2B7Frestore ret
2B80"now like typed file
2B83BlockRead
2B89'read, unexpected EOF
2B8BBlockWrite
2B91write, disk write error
2B95var seg
2B96var ofs
2B97file var ptr
2B99save length
2B9Ado it
2B9Drestore len
2B9Eerror ?
2BA3yes: return
2BA5length = expected
2BA7:yes
2BA9error code -> error
2BAF"return
2BB3BlockRead with result var
2BB9'
2BBBBlockWrite with result var
2BC1get error pos
2BC5result var ptr
2BC8length
2BC9var seg
2BCAvar ofs
2BCBfile var ptr
2BCDsave result var ptr
2BCFdo it
2BD2restore result var ptr
2BD5store record count
2BD7"return
2BDBdo Block-R/W
2BDCrecord length = 0 ?
2BE0yes: file not open
2BE3record len = 1 ?
2BE7:no calculation
2BE9save
2BEBcount * record length
2BEErestore
2BEFlength -> CX
2BF0function code
2BF5file handle
2BF7save DS
2BF8var seg
2BFAdo file operation
2BFDrestore DS
2BFE:ok
2C00error code -> error
2C06nothing read / written
2C09record length
2C0C= 1 ?
2C0Fyes: no division
2C11offset + count done
2C15clear hi
2C17count done / record len
2C19test remainder
2C1B:ok
2C1Dread ?
2C22no: end it
2C24save count done
2C25fill up the rest
2C27var seg
2C29with zeroes
2C2Cdo it
2C2Erestore result
2C2F+1
2C30'
2C31File not open
2C36"
2C37Erase
2C3Bfile var ptr
2C3Crestore ret
2C40delete file
2C42ptr to filename
2C45save DS
2C46ES -> DS
2C48do it
2C4Brestore DS
2C4C:no error
2C4Efile not found
2C53"
2C54Rename
2C58convert string -> ASCIIZ
2C5Bfile var ptr
2C5Drestore ret
2C61Rename file
2C63current file name
2C66save addr
2C67filename ptr
2C6AES <-> DS
2C6Edo rename
2C71ES <-> DS
2C75restore addr
2C76:error
2C78copy new name into file var
2C7Bfile var offset
2C7E64 bytes
2C83copy it
2C84"
2C85ChDir: get error pos
2C89get path name
2C8Crestore ret
2C90get drive #
2C93end of name ?
2C95yes: return
2C97: ?
2C9Ano: no drive specified
2C9Cupcase drive number
2C9F- A
2CA1<:error
2CA3max. O
2CA5:error.
2CA5Please note that MS-DOS now allows more drives !!!
2CA7set default drive
2CA9drive number
2CABset it
2CAEpathname ?
2CB3:none given
2CB5change dir
2CB7pointer to pathname
2CBAset it
2CBD:error
2CBF"
2CC0MkDir
2CC2'
2CC4RmDir
2CC6return addr -> error pos
2CCAget path name
2CCDrestore ret
2CD1get function code
2CD3"do it
2CD5GetDir: CL=max. string len
2CD9dest string
2CDAdrive number
2CDBrestore ret
2CDFdefault drive ?
2CE1:no
2CE3get default drive number
2CE8+1
2CEAdrive number
2CEC-> drive name
2CEEstore in buffer
2CF1store :\
2CF7read current access path
2CF9dest ptr
2CFCdo it
2CFF:ok
2D01no path - mark end
2D04pointer to path name
2D07clear len counter
2D09get char
2D0Bend ?
2D0D:yes
2D0Fnext char
2D10count length
2D12store in dest string
2D14space available ?
2D16:yes
2D18store length
2D1B"
2D1CExecute
2D21Chain: load all of it
2D23get ret addr
2D27file var ptr
2D28restore ret
2D2Cdirect mode ?
2D32yes: error
2D34save begin offset
2D35open file
2D38ptr to filename
2D3Bdo it
2D3Ebegin offset
2D3F:error
2D43seek absolute
2D46clr hi word
2D48do seek
2D4B:error
2D4Dsave DS
2D4ECS -> DS
2D50read byte block
2D52as much as possible
2D55destination
2D58do it
2D5Brestore DS
2D5Cclose file
2D61restore SP
2D65reinit files, I/O
2D68set break vector
2D6E'start - no memory init
2D71File not found
2D73'
2D76Not allowed in direct mode
2D7B"
2D7C'skip message
2DA6'
2DADread version number
2DB0(program size+15)/16
2DB7+CS -> DS
2DBEtop of memory
2DC3max memory size
2DC6stack pointer
2DC9mem - 64K
2DCC:ok
2DCEmax memory size
2DD2small memory: SS at end of DS
2DD4calc SP
2DD6no segment offset
2DD8add to DS
2DDA-> stack segment
2DDD-> stack pointer
2DE1max memory size
2DE4- 64 paragraphs
2DE7= 64K ?
2DEA:less
2DEClimit to 64K
2DF4store -> end of text space
2DF9set stack segment
2DFDset stack pointer
2E01save flag
2E0216 files
2E05init files, I/O
2E08get flag
2E09test it
2E0Bsave it again
2E0C:set
2E0ECrtInit
2E11LowVideo
2E14NormVideo
2E17get flag
2E18test it
2E1A:init
2E1C'go to main loop
2E1Finit vars
2E22beg of text
2E25end of text
2E28clear vars
2E2Amin CS-size = 0
2E2Dmin DS-size = 0
2E30min free heap =  16K
2E36max free heap = 640K
2E3Cclear work filename
2E3Fclear main filename
2E42clear param line
2E45clear error
2E48code destination: memory
2E4Dinit variables
2E50get default drive
2E55store it
2E58ClrScr
2E5Bwrite string
2EA2do LowVideo
2EA5write string
2EB6do HighVideo
2EB9write string
2F58write display type
2F7DY or N ?
2F80store flag
2F83:no
2F85read error messages
2F88clear text
2F8Bwrite menu
2F8Emain loop: restore SP
2F92set a return addr
2F96error ?
2F9B:no
2F9D'search error
2FA0write string with attributes
2FA3CR,LF,>
2FAAget command
2FADconvert to upper case
2FB0save it
2FB1WriteLn
2FB4restore command
2FB5ptr to command table
2FB8search command
2FBBnot found: write menu
2FBE"execute command
2FC1Transfer string into CON buffer
2FC2dest ptr
2FC5DS -> ES
2FC7SI: source ptr
2FC8copy string
2FC9test for end
2FCB:no
2FCDReadln: write string
2FD3read with editing
2FD6buffer ptr
2FD9WriteLn
2FDCget char from buffer
2FDE^Z ?
2FE0yes - end
2FE2space ?
2FE4:no, ret
2FE6skip spaces
2FE7'continue scanning
2FE9"BX now points into buffer
2FEATest end of line
2FED"
2FEEWrite menu
2FF1ClrScr
3007get default drive
300Cconvert to ASCII
300Ewrite its name
302Aget active directory
302Cdefault drive
302Edest buffer
3031do it: get pathname
3034write that pathname
304Awrite current filename
305Fmain filename
3062write it
3065write command menu
30B3end of text
30B6- beg of text
30BAprint number
30C7top of text space
30CA- end of text
30CEprint number
30DD"
30DEshow code direction: this one ?
30E0count it down: no
30F1'
30F2clear field
3101"
3102Option-menu
3105put return addr
3106ClrScr
3109code destination
310Cshow it
311Bshow it
312Cshow it
313Fto COM-file ?
3144:yes
3146'
3149display memory information
316Dmin CS size
3170write hex
317D-(runtime size+15)/16
3186+ 64K
3189write paragraphs
31B3min DS size
31B6write hex
31C3-(min vars used+15)/16
31CC+ 64K
31CFwrite paragraphs
31F9min free heap
31FCwrite hex
3202write paragraphs
322Bmax free heap
322Ewrite hex
3234write paragraphs
3259display command line
3287get command
328Aconvert to upper case
328Dsave it
328EWriteLn
3291restore cmd
3292ptr to command table
3295search command
3298:ok
329A'not found - repeat
329E"execute command
32A1Y or N ?
32A4save result
32A6WriteLn
32A9restore result
32AB"
32ACY or N ?
32B8get char
32BBconvert to upper
32BEY ?
32C0:yes
32C2N ?
32C4no: loop back
32C6save key
32C7display choice
32CArestore it
32CBset flags:
32CD"0=no
32CEWait for ESC
32DFget char
32E2ESC ?
32E4:no, wait
32E6"
32E7Search command in table
32E8compare it
32EA:found
32ECgo to next entry
32F0end of table ?
32F3:no
32F5not found !
32F6"
32F7main command table
3318"end of table
3319option command table
3337"end of table
3338Quit submenu
3339"jump to main menu
333Bpathname of message file (installed by TINST)
3350"
335Ctable of file extensions
336B"
3370search parameters
3375"
3379M:Main file name
338Dflag: text not compiled
3390pointer to pathname
3393Enter new name
3396mark end
339B:nothing read
339Dparse filename
33A0dest buffer
33A3copy to main file name
33A6"
33A6W:Work file name
33A7set error vec: new file
33ADsave, if changed
33C4ptr work file name
33C7Enter new name
33CAmark end
33CF:something read
33D1clear text
33D4'back to main menu
33D7parse filename
33DAcopy to work file name
33E0'now load it
33E2set error vec: not found
33E8set error vec: too big
33EEclear text
33F1work file name
33F4beg of text
33F8save parms
33FAclear editor vars
33FErestore
33FFbegin addr
3401end of space
3405load file
3409set end of text
340D"
340ELoad file: save start pos
340Fsave end pos
3410copy pathname[SI]
3421write pathname
3424open file
3427current pathname
342ADS -> ES
342Cdo it
342Ffile handle
3431restore parms
3433:error
3435calc max length
3437read byte block
3439do it
343C:error
343Elength = expected ?
3440yes: too big !
3442get length done
3443end addr
3445DS -> ES
3447search ^Z in the block
344C:not found
344Ego back one byte
344Fclose file
3455end pos of text read
3457"
3458file too large: close file
345Bend of text space
345D+1
345E"handle error
3462file not found
3464end addr
3465"handle error
3469File not found - ESC
346Cattribute #3
3481wait for ESC
3484"HighVideo
3487file not found - ESC
348A"clear work file name
348CNew file: test error code
348E:invalid dir
3490WriteLn
3493attribute #2
34A5save end pos
34A6wait 2 s
34ACrestore
34AD'
34AEWriteLn
34B1Attribute #3
34C9"clear work file name
34CBFile too big
34E1end of text-1 -> BX
34E6"wait for ESC
34E8file too big
34EBclear work file name
34F0"main loop
34F3Save if modified
34F5set flag
34F6'
34FAtext changed ?
34FF:no - ret
3501test flag
3512write path name
3529clear change flag
352EY or N ?
3531:yes
3533'
3534S:Save file - get filename
3537clear change flag
353Cptr work file name
353Fcopy it
354Fwrite path name
3555copy filename into buffer
3558extension .BAK
355Bmodify file name
355Edelete old .BAK file
3560scratch file name
3563do it
3566rename file
3568current filename
356Bnew filename
356Edo it: rename to .BAK
3571create new file
3573no attribute
3575current filename
3578DS -> ES
357Ado create
357D:error
357Ffile handle
3580beg -> offset
3584end of text
358Astore ^Z at the end
358Dcalc length
358F+1
3590write byte block
3592do it
3595:error
3597length = expected ?
3599:no
359B'close that file
359Eset changed flag
35A3close that file
35A6erase new file
35AErename it back to .PAS
35B0.BAK
35B3-> .PAS
35B6do it
35B9WriteLn
35BCwrite message
35BF"return to main menu
35C2File not saved
35ECwait for ESC
35EF"
35F2D:Directory
35FEenter dir mask
3601*, ? allowed
3604parse filename
3607line end ?
360Aset DMA transfer addr
360Cbuffer
3612test pathname
3615get char
3617go to next
3618* ?
361A:yes
361C?
361E:yes
3620end of string ?
3622:no
3624get last char
3627ptr to *.*
362A: ?
362C:yes
362E\ ?
3630:yes
3632search first dir entry
3634attribute
3637pathname
363Ado it
363D:error
363Fattribute ok ?
3644yes, take it
3646ptr to \*.*
365Dwrite path name
3660WriteLn
3663get first entry
3665attribute
3668path name
366Bdo it
366E:error
3670clear flag
3672test flag
3674:not first entry in line
3677line length / 16
3682ptr to filename
3685test attribute
3689:ok
368Bdirectory ?
3690LowVideo
3693write name
3696NormVideo
3699another one in this line ?
369B:no
369Dend for padding
36A0calc length
36A2pad with spaces
36A4write space
36A7:another one
36A9'next dir entry
36ABWriteLn
36AEget next entry
36B0save tab
36B1get it
36B4restore tab
36B5:ok, write it
36B7(redundant !)
36B9'end it
36BBWriteLn
36D0do CR
36D2test tab flag
36D4:no CR
36D6WriteLn
36D9WriteLn
36DCget drive number
36E0convert
36E3get disk free space
36E8invalid drive ?
36EB:yes
36EDcalc bytes/block
36EFmany ?
36F1:yes
36F3* number free blocks
36F5DIV 1024
36FFwrite number
3712"
3713L:Logged drive
3720Read line
3723get char from buffer
3725EOF ?
3727:no
3729get default drive
372E'ok
3730convert it
3733< A ?
3735:wrong
3737> O ?
3739:wrong
373Bsave it
373Creset disk system
3741restore drive
3742set default drive
3747"
3748A:Active directory
3759read string
375Cnothing: ret
375Esource
3760dest: std pathname
376564 bytes
3768DS -> ES
376Acopy it
376Drestore ptr to beg
376Fsearch ^Z
3776not found: invalid
3778mark end with 0
377Cchange directory
3781error ?
3783:no
3785Bell
3787write it
378A"
378BDisplay space information
379B(code size-runtime length)/16
37A2(already in paras)
37AAwrite number
37B3(64K-code size)/16
37BDwrite para
37D7(Data size-std vars)/16
37DE(already paras)
37E6write number
37EF(64K-data size)/16
37F9write para
3807code destination ?
380C:memory
3813:COM-File
3815'
3826display min stack size
3829write number
382C'WriteLn
383Fmin heap/stack size
3842write number
3861max heap/stack size
3864write number
3877"
3878write number hex and dec
3879write para
3882restore number
3883clear hi
3888* 16
388C:another shift
388Enumber
3890field length
3893write DX:BX
38A1"
38A2Write para: hex number
38B4"
38B5WriteLn para
38B8"
38BBRead hex
38BDsave number
38BEget char
38C0UpCase
38C3-> CH
38C5restore number
38C6ASCII-translation
38C9:< 0 - end
38CB> 9 ?
38CEno: ok
38D0A..F
38D3< A ?
38D6yes: end
38D8> F ?
38DByes: end
38DDnumber * 16
38E1add digit
38E3next char
38E4'continue
38E6"
38E7F:Find Error
38F3ReadLn
38F6:ok
38F8'nothing entered
38F9read hex
38FCstore error position
38FFset flag: not compiled
3902get file, if necessary
3905set flag: searching
3919"do it...
391BC:Compile - get file
391Eset dest file
3930to memory ?
3935:yes
3940display dest path name
3946WriteLn
3949Call compiler
394CCOM/CHN produced ?
3951:no
3953error ?
3958:no
395Aset dest file
395Ddelete it
3965Compilation aborted ?
396A:no
396CWriteLn
396FWriteLn
398C'return to main menu
399Cerror ?
39A1:yes
39A3find error pos ?
39A8:yes
39AAdisplay space info
39AD'
39AEerror pos not found
39D9'return to main
39DBI/O-error ?
39E0:no
39E2write message
39E5WriteLn
39E8'return to main menu
39EBError pos found ?
39F0:no
3A13'jump to this position
3A16Error message
3A23get error number
3A28write it
3A2Berror msgs included ?
3A30:no
3A32pointer to messages
3A35get char
3A37^Z ?
3A39yes: not found
3A3Bcontrol char ?
3A3D:yes
3A3Fget digit
3A41* 10
3A4Cget second digit
3A4Econvert
3A50next char
3A51= error number ?
3A55:yes
3A57get char
3A59next one
3A5Aend of line ?
3A5Cno: search it
3A5Enext char: skip LF
3A5F'continue searching
3A61Display error message
3A67get char
3A69CR ?
3A6Byes: done
3A6Dcontrol char ?
3A6F:no - write it
3A71^Z ?
3A73yes: done
3A75pointer to messages
3A78get char
3A7Ago to next
3A7Bcontrol char ?
3A7Dno: search end of line
3A7Fis it the right one ?
3A81:no, next line
3A83get char - write sub-message
3A85CR ?
3A87:end
3A89write it
3A8Cnext one
3A8D'continue
3A8Fsearch end of line
3A91next char
3A92CR ?
3A94:no
3A96skip LF
3A97'continue searching
3A99display char
3A9Cgo to next
3A9D'continue
3A9Fwork file used
3AA4error in include file ?
3AA9:no
3AADwrite char
3AB6copy include file name
3AB9into work file name
3ABCdo it
3ABFload that file
3AC2WriteLn
3AED'go into editor
3AEFmain file exists ?
3AF4:no
3AF6copy main into
3AF9work file name
3AFCdo it
3AFFwait for ESC
3B02get error pos in text
3B07"jump into editor
3B0AM:memory
3B0F"set flag
3B10C:COM file
3B15"set flag
3B16H:CHN file
3B1B"set flag
3B1CO:CS size
3B39read it
3B3Cdefault
3B3F:nothing entered
3B41read hex
3B44add runtime size
3B47convert to paras
3B4Dstore min CS
3B50"
3B51D:DS size
3B6Eread it
3B71default
3B74nothing entered: set it
3B76read hex
3B79add std vars size
3B7Econvert to paras
3B82store min DS
3B85"
3B86S:SS size
3BA4read it
3BA7default: 16K
3BAAnothing entered: set it
3BACread hex
3BAFstore min SS
3BB2"
3BB3A:Max. SS size
3BD1read it
3BD4default: 640K
3BD7nothing entered: set it
3BD9read hex
3BDCstore max SS
3BDF"
3BE0P:Parameter line
3BEEptr to buffer
3BF1Read line with default
3BF4copy it
3BF7count
3BFAget char
3BFC^Z ?
3BFEyes: end
3C00store in buffer
3C02next char
3C04:another char
3C06mark end of param line
3C09"
3C0Aload file, if necessary
3C0F:work file defined
3C11get work file name
3C14main file ?
3C1C:work file exists
3C1Ecopy work -> main file name
3C21use work file
3C23'
3C25work = main ?
3C28:yes
3C2Asave without question
3C2Dset error vectors
3C39main file
3C3Cload it
3C3Fset flag: main file
3C41store flag
3C44clear error flag
3C49"
3C4ASet dest file name
3C4Dmain file name ok ?
3C50not null - ok
3C52use work file name
3C55copy to scratch file name
3C58set extension .COM
3C5Eset flag: memory
3C63memory ?
3C65:yes
3C67flag: file
3C6CCOM ?
3C6E:yes
3C70flag: CHN
3C75set extension .CHN
3C78modify file name
3C7B-> dest file name
3C7Ecopy it
3C81"
3C82R:Run
3C87:already compiled
3C89compile it
3C8Cmemory: ok
3C91yes: do it
3C93COM-file ?
3C9AWriteLn
3CC6'return to menu
3CC9copy command line
3CCCto start of CS
3CCFseg of compiled program
3CD3clear offset
3CD5get char
3CD7end ?
3CD9:yes
3CDBnext char
3CDEstore that char
3CE0'continue
3CE3store CR at the end
3CE8store length
3CF9CS of program
3CFDstart of program
3D01'start program
3D02return point from program
3D03error ?
3D0Aget error position
3D10flag
3D13"reinit
3D16Clear text
3D1Atext beg -> text end
3D1Etext not changed
3D23work file
3D28text not compiled
3D2D"
3D2EQ:Quit - save changes
3D31CrtExit
3D34end of process
3D36"return to MS-DOS
3D39Get current file name
3D3E:work file
3D40main file ?
3D45:yes
3D47set work file name
3D4A'
3D4Cmain -> work file name
3D55flag: main file
3D5Aget filename
3D5Dmain file ?
3D62:no
3D64save without question
3D67load that file
3D6A"
3D6Bmain = work file ?
3D71get char
3D73compare it
3D75:not equal
3D77end ?
3D79:yes
3D7Bnext char
3D7D'continue
3D7Fset flag: false
3D81"
3D82Read error message file
3D85set text beg
3D88set error vectors
3D94ptr to pathname
3D97scratch pathname
3D9Asave ptr
3D9BDS -> ES
3D9DCS -> DS
3D9Fcopy filename
3DA2ES -> DS
3DA4restore ptr
3DA5load file
3DA8store its end position
3DACstore ^Z at the end
3DAFnext char
3DB0-> new text beg
3DB4"
3DB5write string [SI]
3DB6no change
3DB9'
3DBBwrite pathname: save BX
3DBCvector: UpCase
3DC0get char
3DC1end ?
3DC3:no
3DC5modify char
3DC7write it
3DCA'continue
3DCCrestore
3DCD"
3DCEwrite number - unformatted
3DD0do it
3DD3"
3DD4write number - 5 digits
3DD7clear hi word
3DD9'
3DDBwrite number DX:BX
3DDDsave regs
3DE0DS -> ES
3DE2CS -> DS
3DE4dest buffer
3DE7number to write
3DE9save field size
3DEBformat flag (leading zeroes)
3DEDptr decimal table
3DF07 digits
3DF2clear digit
3DF4count up
3DF6do successive subtraction
3DFB:continue
3DFDrestore number
3E02next table entry
3E05restore digit
3E07:not zero
3E09test flag
3E0Dconvert to ASCII
3E0Fstore in dest buffer
3E10set flag
3E11another digit ?
3E13:yes
3E15digits done ?
3E17:yes
3E19put a 0
3E1Cdigit count
3E1Dwrite a zero at the end
3E20restore field size
3E21ES -> DS
3E23fill up with spaces ?
3E25:no
3E27space count
3E29make space in buffer
3E2Emove it up
3E30now fill with spaces
3E36buffer ptr
3E39write string
3E3Crestore regs
3E3F"
3E401000000 decimal table
3E44 100000
3E48  10000
3E4C   1000
3E50    100
3E54     10
3E58"      1
3E5Cparse filename: no wildcards allowed
3E5Fdest: scratch file name
3E62get 2 chars: drive spec
3E64UpCase
3E67control char ?
3E69:yes
3E6B: ?
3E6E:no
3E70next char
3E72'set drive
3E74get default drive
3E79-> ASCII
3E7Dstore drive spec
3E81test path ?
3E83:no
3E85\ ?
3E88:yes
3E8Astore \
3E8Eget current path
3E90drive number
3E95destination
3E97do it
3E9A:error
3E9Csearch end of path
3E9F:found
3EA1get char
3EA3end ?
3EA5:found
3EA7next char
3EA8end of buffer ?
3EAC:not yet
3EAE'end it
3EB0store \
3EB3next char
3EB4end of buffer ?
3EB7:yes
3EBAclear flag
3EBCCS -> ES
3EBFget char
3EC1control / space ?
3EC3:yes
3EC5save cnt, dest ptr
3EC7test: illegal char ?
3ECACL is count for this search
3ECBsearch char in table
3ECCrestore
3ECEfound: end it
3ED0next char
3ED1store it
3ED3next char in dest
3ED4end of buffer ?
3ED8:no
3EDAmark end
3EDD"
3EDE"table of illegal chars
3EEDpointer: .PAS
3EF0save extension ptr
3EF1parse filename
3EF4restore ext ptr
3EF5only set if no ext
3EF7'do it
3EFB'
3EFDset file extension
3EFFptr scratch file name
3F02clr dot pos
3F04get char
3F06end ?
3F08:yes
3F0Anext one
3F0Bsearch dot ?
3F0E:no
3F12:no
3F14store pos of dot
3F16\ ?
3F18:no
3F1Aclear dot pos
3F1C'continue
3F1Etest dot pos
3F20:not set
3F22set extension ?
3F24:no
3F26dot position
3F28go back
3F29set extension
3F2Alength of extension
3F2C-> count
3F2E:nothing to do
3F30buffer end ?
3F34:yes
3F36next pos
3F38get ext char
3F3Astore it
3F3Cnext one
3F3D:another char
3F3Fmark end
3F42"
3F43copy scratch -> [DI]
3F46'
3F48copy [SI] -> scratch
3F4BDS -> ES
3F4Dcopy 64 bytes
3F52do it
3F53"
3F54write scratch file name
3F57"
3F5Awrite work file name
3F5D"
3F60Display work file name
3F63DS -> ES
3F66get char
3F67UpCase
3F6Awrite it (drive)
3F6Dget char
3F6Ewrite it (:)
3F71search end of filename
3F75any length
3F7Asearch it
3F7Bbackward search !
3F7Cnow search \
3F7Eany length
3F83do it
3F84position of file name
3F86without dir path
3F88"write it
3F8BPrint string with highlighting
3F8Cstring: inline, 0=end
3F8Eget return addr
3F91save
3F93get char
3F96go to next
3F97end ?
3F99:yes
3F9Bhighlighted ?
3F9D:yes
3F9FLowVideo
3FA2'write it
3FA4NormVideo
3FA7mask out bit 7
3FA9zero: end
3FABwrite it
3FAE'next char
3FB0restore
3FB2restore ret
3FB6"
3FB7NormVideo
3FBCalready set: ret
3FBEset flag
3FC3'do it
3FC6"
3FC7LowVideo
3FCC:already set
3FCEset it
3FD3"
3FD6Attribute #3
3FDB:already set
3FDDset it
3FE2save
3FE3set that attribute
3FE9restore
3FEA"
3FEBAttribute #2
3FF0:already set
3FF2set it
3FF7save
3FF8set that attribute
3FFErestore
3FFF"
4000Block transfer [BX]->[DX]
4002forward = delete
4004DS -> ES
4007CX=count
4008do it
4009point to block end
400D"
400EBlock transfer [BX]->[DX]
4010backward = insert
4012DS -> ES
4013BX,DX point to block END !
4016do it
4017reset dir flag
4018point to block beg
401C"
401DInit editor vars
4022390..3B0:=0
4028DS -> ES
402Afill
402D3B1..3B2:=1
402Eold len, redisplay from
4036Words 3BA..3BD:=2
4037block pos in buffer
403F3B3..3B8:=FF
4042set flags:
4045insert, indent, display
4048redisplay
404AWords 3BE..3C8:=046C
404Dcurrent pos, pos in line buffer
4050pos FIFO = beg of line buffer
40553CA..45F:=0
4057command entry buffer, search,
405Areplace, option, filename
405Fcommand buf:  3 chars
4064search word: 30 chars
4069replce word: 30 chars
406Eoption word: 10 chars
4073file name:   64 chars
4078end file name buffer
407Dend line input buffer
4083no flicker
4085mono screen segment
4088mode = 7 ?
408Dyes: mono
4090get flicker flag
4093set segment
4095store flicker flag
4098store segment
409C"
409DClear editor vars
40A1set to beg of text = BX
40B5"
40B6flush changes
40BAbottom-1
40C2set cursor pos
40C5NormVideo
40C8end of text
40D0store ^Z at the end
40D3"return to main menu
40D6E:Editor - get file name
40D9position flag
40DCsave pos
40DDend of text
40E1store CR,LF there
40E9status line obsolete
40EEredisplay all
40F3pos of word separator tab
40F9NormVideo
40FCClrScr
40FFrelative text pos
4100+text beg+1
4105set new pos
4108redisplay
410Bclear status line
410Fanything to erase ?
4111:no
4113cursor pos: home
4119LowVideo
411Cspace
411Ewrite char
4121another ?
4123:yes
4125clear erase flag
4129display status line
412Cget command
412F:no command - enter char
4131:not found
4133MSB vector = 1 ?
4136:no
4138set flag: text changed
413Dcode invalid
4142mask vector
4145store return addr
4148-> main loop
414Ado position FIFO
41508 bytes
4153'move back, jump to command
4156^P:Control char prefix - display
4159get char
415C'enter this char
415Eflag: text changed
4161code invalid
4166pos in line
416Aline full ?
416Eyes: ignore char
4170overwrite ?
4175:yes
4177save it
4178make space for char
417Brestore it
417Cstore char
417Ecursor right
4180redisplay line
4184new pos in line buffer
4188reposition in line
418B"main loop
418EGet command: get key
4191Delete ?
4193:yes
4195control char ?
4197no: no command
4199pointer to cmd buf
419Cstore length
41A0store char
41A2save pos in buf
41A3ptr cmd buf
41A6ptr first cmd table
41A9must be equal
41ABsearch in table
41AErestore pos
41AFtest result
41B1:found
41B3save again
41B4ptr cmd buf
41B7ptr second cmd table
41BAsecond char without ctrl ok
41BCsearch in table
41BFrestore pos
41C0test result
41C3:not found
41C7:need another key
41C9ptr jump table
41CC+2*cmd number
41D1get jump addr
41D3ok
41D4'
41D5display command char
41D8save stat
41D9get key
41DCinc lenght cmd buf
41E0next pos
41E1store char
41E3restore stat: function key ?
41E4:continue
41E6display
41E9"try it again
41EBdisplay command sequence
41EElate - ret
41F0save pos
41F1clear char count
41F3number of chars to erase
41F7set position: home
41FAptr cmd buf
41FDget cmd length
41FFsave len
4200next char
4201get char
42032 chars to erase
4208put char
420Brestore len
420Canother char ?
420E:yes
4210restore
4211"
4212Display control code - save char
4213set attribute
4216restore char
4217control ?
4219:yes
421B'write char
421Esave char
4220write ^
4225restore char
4226-> normal char
4228write it
422Brestore char
422C"
422DSearch command in table
422Fsave cmd comparison mask
4230command buf ptr
4231restore
4234get char from table
4236next pos
4237end of table ?
4239:yes
423Bcommand number
423Dsave
423Fget command len
4241go to first char
4242>= table len ?
4244:yes
4246skip this entry
4248'try next one
424Asave flags
424Bsave table entry length
424Dchar from table
424Fcompare them
4251mask difference
4253:not equal - next one
4255next char
4257= length of cmd ?
4259no: compare
425Brestore flag, table entry length
425Drestore
425Fmode: none
4261found
4263:found
4265need another char
4267'
4268restore length
4269skip entry
426Dclr hi
426Fadd to ptr
4271"try next one
4273Display status line: Get KBD stat
4276late: ret
4278LowVideo
427Bobsolete ?
4280no:just display pos
4282clear flag
4287screen position
428Aremember cursor pos
428Ecolumn
4292set cursor pos
4295clear line
4299screen width sufficient ?
429E:no
42A0set cursor pos
42A6display filename
42A9cursor pos
42ACput string
42B5cursor pos
42B8put string
42C0cursor pos
42C3Overwrite ?
42C8:yes
42CAput string
42D8'
42DBput string
42E9Indent ?
42EE:no
42F0put string
42FAcalc column
4303= old col ?
4309set that column
430Ccursor pos
430Fset it
4312LowVideo
4315number -> BX
4317clr hi
43193 chars
431Bdisplay number
431Ecurrent pos = old pos ?
4326no: display line number
4328'restore cursor pos
432Brestore cursor pos
432EGet KBD stat
4333beg of text
433Bline number
433Ecalc count
4340:done
4342forward search
4343DS -> ES
4345search LF
4349:not found, done
434Bcount it
434C256 lines counted ?
434E:no, continue
4350Get KBD stat
4353:nothing entered
4357cursor pos
435Asave line number
435Bset cursor pos
435ELowVideo
4361restore number
43625 digits
4364write it
4367current pos -> old pos
436F"restore cursor pos
4372Write number: save field length
4373clear flag
4375convert number
4378restore length
4379counter
437B:done
137Dcounter
437Fpad with spaces
4381put it
4384another ?
4386:yes
4388"
4389number -> decimal
438E0: store a 0
4390digit 10000
4396digit  1000
439Cdigit   100
43A2digit    10
43A8digit     1
43ABclear digit
43ADdo successive subtraction
43AF:done
43B1count digit
43B3'
43B5restore number
43B7convert to ASCII
43B90 ?
43BB:no
43BDis it a leading zero ?
43C1set flag
43C3"write char
43C6Input from status line
43CCdestination ptr
43D0point to string
43D1get old length
43D3clr old length
43D6go to string
43D7flag: editing stat line
43DCsave regs
43DFprocess key
43E5restore flag
43EAno command: put char
43EC:valid command
43EEget command
43F1test for interrupt
43F4'loop back
43F6command code
43F8CR ?
43FA:no
43FCstore ^Z at the end
43FF'return
4400Character right ?
4402:no
4404get length
4407= pos ?
440Bgo right
440E'get char from old value
4410word right ?
4412:no
4414length = old len ?
4419yes: loop
441Bget char
441Dwrite it
4420next one
4421inc len
4424'until end
4426Word left ?
4428:no
442Adelete char
442D:ok, continue
442F'end reached, loop
4431Control char prefix ?
4433:no
4435get a key
4438'put it
443ATest delete codes
443C:delete left
4440:del left
4444:char left
4448:no delete
444Adelete char
444D'loop back
444Fword right ?
4454:yes
4456'loop back
4459save char
445Bcurrent len
445E< max len ?
4460:ok
4462'loop back
4465inc length
4468store char
446Aget char
446Cgo to next
446Ddisplay it
4470get current len
4473= old len ?
4475:no
4477'loop back
447Aget pos
447D'loop back
4480Delete char: get len
44830 ?
4485yes: nothing to delete
4487dec length
448Ago back one char
448Bwas it a control char ?
448E:no
4490delete two chars
4493delete one char
449Aset flag
449E"
449F^QF:Find - set mode flag
44A4get find word
44A7get option string
44AA"do it
44ACGet find word: clear stat line
44AFwrite string
44B7dest: find word
44BA"read string
44BDGet repl word: clear stat line
44C0write string
44D0dest var
44D3"read string
44D6Get Options: clear stat line
44D9write string
44E4dest var
44E7read string
44EBend of screen
44F1beg of line
44F3"set cursor pos
44F6^QA:Search & Replace
44FBget find word
44FEget replacement word
4501get option string
4504"do it
4506^L:Repeat last find
4509write back current line
450Cend of line buffer
450F+1
4510or current pos in line
4517- beg of buffer
451C+ current pos
4522-> search pos
4526line count
452Ctext end-1
4531-> search end
4535text beg -> search beg
453Dptr option string
4540get length
4542clear option flag
4547empty ?
4549:no
454B'no options set
454DProcess option line
454Enext char
454Fget char
4551valid digit ?
4553:no
4555> 9 ?
4557:no digit
4559-> number. Get line count
455Csave digit
455Dcurrent count * 10
4563+ digit
4566-> line count
4569'continue
456BUpCase
456EW ?
4570:no
4572flag: whole words
4577U ?
4579:no
457Bflag: ignore upper/lower
4580N ?
4582:no
4584flag: replace without asking
4589G ?
458B:no
458Dflag: global
4592B ?
4594:no
4596flag: backwards
459BL ?
459D:no
459Fflag: search block
45A4clear global
45A9search block, only
45ADblock end -> search end
45B1block beg -> search beg
45B9another option char ?
45BB:yes
45BDat least one line to do
45C2:ok
45CAbegin limit
45CEoption
45D1backwards ?
45D3:no
45D5end limit
45D9block & global ?
45DB:no
45DDcurrent pos
45E1store search pos
45E5backwards ?
45EA:yes
45EC= search limit ?
45F0:no, continue
45F2'done
45F5go back
45F6= search limit ?
45FA:no
45FC'end it
45FFptr searched word
4602get length
4607backwards ?
460C:no
460Ego to its end
4618whole words ?
461D:no
461Fsave
4621at the beginning ?
4624get char
4626restore
4628:at beg
462Ais it alphanum ?
462D:yes - continue searching
462Flength = 0 ?
4631:found
4633compare chars
4636:not the same
4638another char ?
463A:yes
463Cwhole words ?
4641:no
4643save
4644end ?
4647get char
4649restore
464A:at the end
464Calphanum ?
464Fyes: not valid
4651backwards ?
4656:yes
4658end of text ?
465Dsearch mode ?
4662:find
4664replace it
4667block global ?
466C:yes
466E'continue
4671another line to process ?
4675:no
4677'continue
467A'set new pos
467Dsave pos
467Eat the end ?
4681restore
4682:yes
4684backwards ?
4689:no
468Bgo back
468C'
468Enext char
468F'continue
4691get current search pos
4695at the end ?
4698:yes
469A'continue
469Dend search: limit new pos
46A0set pos
46A3global block ?
46A8:no
46AAclear status line
46ADwrite string
46C8"wait for ESC
46CBset position
46CE"restore line
46D1Set pos
46D5text end - 1
46D6= current ?
46D8:below
46DAlimit it
46DCsave
46DEsearch beg of that line
46E1-> current pos
46E5-> DX
46E7restore
46E8calc pos in line
46EA+ buffer offset
46EF-> pos in line buffer
46F3reposition in current line
46F6do selective rewrite
46F9restore pos
46FA"
46FBbring BX into range:
46FF>= text beg,
4707"< text end
470Achar in alphanum ?
470C<0: no
47100..9: yes
4714<A: no
4718A..Z: yes
471C<a: no
4720a..z: yes
4722test flag
4724"
4725At the beginning ?
472A:forward
472D= search limit end ?
4732'
4733end reached ?
4738:forward
473B= search limit beg ?
473F"
4740Compare chars
4742get char in search string
4746wild card ?
4748yes: ok
474Acompare it
474Cyes: ok
474Eignore upper/lower ?
4753:no, just compare
4755is it a valid char ?
4758:no
475Amask different bits
475E'
475Fcompare it
4761"
4762Do replace
4763get KBD stat
4766nothing: display it
4768replace without asking ?
476D:yes
476Fset new position
4772redisplay
4775replace without asking ?
477A:yes
477Cclear status line
477Fwrite string
4792Blink cursor: alternate
4796status line / cursor pos
479Aset cursor pos
479Ddo 4 times
47A0get KBD stat
47A3:key pressed
47A5wait 100 ms
47A8save count
47A9Delay
47ACrestore
47AD:another
47AFpos:status line
47B2set cursor pos
47B54 times
47B8get KBD stat
47BB:key pressed
47BDwait 100 ms
47C0save cnt
47C1Delay
47C4restore cnt
47C5:another
47C7'blink again
47C9get char
47CCtest interrupt
47CFUpCase
47D2Y ?
47D4:yes, do it
47D6^Y ?
47DAset flags: text changed
47DFcode invalid
47E4length of replacement
47EArestore pos
47ECsave
47EDlength of word found
47F0- length of replacement
47F2-> CL
47F4save flags
47F6do sign extension
47FAbackwards ?
47FF:yes
4801beg of that word
4805flag
4808: no difference
480Achange len
480Drestore
480Flength = 0 ?
4815move in replacement word
481Bget KBD stat
481E:nothing
4820redisplay all
4823'
4825save pos
4826restore line
4829flag: redisplay
482Crestore pos
482Dbackwards ?
4832:yes
4834remove
4835set to end of word
4837'
4838restore beg of word
4839"
483A^KW:Write block to disk
483Fblock hidden: ret
4841rewrite line
4844restore line
4847block begin > block end ?
484Eyes: ret
4850test block
4853restore line
4856clr status line
4859write string
4870get filename
4873nothing entered: ret
4875default extension .PAS
4878open file
487Bname ptr
487EDS -> ES
4883file handle
4887close file
488Cclr status line
48A1write filename
48A7Y or N ?
48AAno: get new filename
48ACcreate file
48AEname ptr
48B1no attribute
48B3DS -> ES
48B8:ok
48BAclr status line
48BDwrite message
48D2write filename
48D8wait for ESC
48DB'get new filename
48DEsave file handle
48DFclr status line
48E2restore
48E3block begin
48E7block end
48EBget char at block end
48EDsave it
48EEsave its addr
48EFstore a ^Z there
48F2count = block end - block beg
48F6write to device ?
48F9:yes
48FBfile: write ^Z, too
48FCwrite byte block
4901:error
4903length = expected ?
4905:yes
49071 byte difference ?
4908no: error
490Aclose file
490D:ok
490Fwrite message
4925wait for ESC
4928restore char at block end
492C'
492Dclose file
4930delete it
4932name ptr
4938write message
4945wait for ESC
4948'restore block end
494Aclose file
494C"
494Fget filename
4952read it
4955first char
4958= ^Z ?
495B"yes: nothing entered
495C^KR:Read block from disk
495Fwrite string
4977get file name
497Anothing entered: ret
497Cdefault extension .PAS
497Fopen file
4982name ptr
4985DS -> ES
4987do it
498Afile handle
498B:ok
498Dclr status line
4990write message
4999write filename
499Fwrite string
49ADwait for ESC
49B0'get another filename
49B2save file handle
49B3flag: block not hidden
49B8test block
49BBtext end
49BFtext space end
49C3+ some space free
49CAsave free space
49CDnew block beg
49D2make space
49D5restore free space
49D6restore file handle
49D7new block beg
49DB-> offset
49DFsave end free space
49E3set error vec
49E9load block
49ECend of block read
49EDstore as new block end
49F1-> DX
49F3new block beg
49F7-> block beg
49FBend free space
49FF-block end
4A01-> count
4A03'remove unneeded space
4A05File too big:
4A09remove space made free
4A0C"error: out of space
4A0F^KV:Move block - test block
4A14copy it
4A17new block beg
4A1B-> block beg
4A23+ count
4A25-> block end
4A29old block beg -> BX
4A2Cremove old block
4A2Fblock begin
4A33set position
4A36'rewrite all
4A39"restore line
4A3C^KC:Copy block - test block
4A41do copy it
4A44new block beg
4A48-> block beg
4A4C+ count
4A4E-> block end
4A52selective redisplay
4A55restore line
4A58"rewrite all
4A5BTest block
4A60:block not hidden
4A63'
4A64search end of input line
4A67+1
4A68pos in input line
4A6Csave it
4A6Dtake smaller of them
4A70-> BX
4A72write back to memory
4A75restore pos in input line
4A76calc relative pos in input line
4A7B+pos of current line
4A81-> new block beg
4A85save
4A86block beg+1
4A8Bdestination inside block ?
4A8Dblock end
4A91:no
4A95:no
4A97dest is in old block...
4A99'end it
4A9Bblock beg
4A9F-block end
4AA1-> - block len
4AA5-> count
4AA7restore destination
4AA8"
4AA9Copy block: make space for it
4AACget count
4AB0(is - block len)
4AB2block destination
4AB6block source
4ABAsave count
4ABBmove it
4ABErestore count
4ABF"
4AC0^KY:Delete block - rewrite line
4AC3block hidden ?
4ACAblock beg
4ACEsearch beg of line
4AD1-> current pos
4AD5update pos FIFO
4AD9inside block ?
4AE0:no
4AE8:no
4AEAcurrent pos
4AEE-> FIFO
4AF2block end-block beg
4AFAcalc count
4AFC:ok
4AFE'restore line
4B01-> count
4B03swap addrs
4B05save them
4B08do selective rewrite
4B0Crestore
4B0Edelete block
4B11current pos
4B15-> block beg
4B19-> block end
4B1Drestore line
4B20"rewrite all
4B22^KH:hide / unhide block
4B23toggle flag: block hidden
4B27"rewrite all
4B29Mark block end
4B2Apos in line
4B2E-> block end in buffer
4B32line pos
4B36-> block end
4B3Ablock marked in this line ?
4B40set that flag
4B45block hidden ?
4B4Amake it visible
4B4Fhidden: rewrite all
4B52no block marked in line: all
4B54"rewrite line, only
4B56Mark block beg
4B57get pos in line
4B5B-> block beg in line buffer
4B5Fcurrent pos
4B63-> block beg
4B67block beg in this line ?
4B6Dset flag
4B72"as above
4B74^QB:to beginning of block
4B77block beg
4B7B"set new position
4B7E^QK:to end of block
4B81block end
4B85"set new position
4B88Rewrite line
4B8Apos cursor to beg of line
4B8Dpos of current line
4B90critical line
4B95display it
4B98normal again
4B9D"
4B9Erewrite line
4BA1"then rewrite all
4BA4^QC:to end of text
4BA7text end
4BAB"set new position
4BAE^QS:to beg of line
4BB1buffer beg -> pos in line
4BB5"reposition in line
4BB8^QD:to end of line
4BBBsearch end of line+1
4BBCtoo much ?
4BC1:no
4BC3limit it
4BC6set new pos in line
4BCA"reposition in line
4BCD^V:insert mode on/off
4BD2toggle flag
4BD6"status line obsolete
4BD7^QI:indent mode on/off
4BDCtoggle flag
4BE0"status line obsolete
4BE1put cursor to current pos
4BE9"set cursor pos
4BEC^X:line down
4BF0go down one line
4BF5rewrite line
4BF8now really go down
4BFFstore new pos
4C03flag: short update
4C0Ddo selective redisplay
4C10clear flag
4C15"restore line
4C18^E:line up
4C1Cgo up one line
4C21save pos
4C22rewrite line
4C25now go there
4C26"set it
4C28^W:scroll up
4C2Bdisplay beg = text beg ?
4C2Fyes: ret
4C31rewrite line
4C34count pos on screen
4C36current pos
4C3A= display beg ?
4C3Eyes: do it
4C40go up one line
4C43count it
4C44'
4C46current pos = top of screen
4C4Bline count - 3
4C50= count ?
4C52no: ok
4C54go up one line
4C57save current pos
4C58display beg
4C5Cgo up one line
4C5Fdisplay it
4C62restore current pos
4C63"set new pos
4C65^Z:scroll down
4C68save current pos
4C6Cstart from display beg
4C73line count-2 -> CX
4C7Ago down one line
4C7Ddo it again
4C80set new pos
4C84restore old pos
4C85:set new pos
4C87>= display beg ?
4C8B:set new pos
4C8Dgo down one line
4C90'set new pos
4C92"
4C93^QE:to page top
4C97display beg = current line ?
4C9Byes: done
4C9Dsave this pos
4C9Erewrite line
4CA1display beg -> new pos
4CA2"set that pos
4CA4^QX:to bottom of page
4CA7display beg
4CABline count-3 -> CX
4CB5go down one line
4CB8:again
4CBA"set new pos
4CBC^C:page down - rewrite line
4CC0line count - 2
4CC5-> CL, CH
4CC9display beg
4CCDgo down one line
4CD2:another one
4CD4store new display beg
4CD8current pos
4CDCgo down one line
4CDF:again
4CE1set new pos
4CE5redisplay
4CE8redisplay all
4CEB"restore line
4CEE^R:page up - rewrite line
4CF2line count - 2
4CF7-> CL, CH
4CFBdisplay beg
4CFFgo up one line
4D04:another
4D06store new display beg
4D0Acurrent pos
4D0Ego up one line
4D11:another
4D13"set new pos, redisplay
4D15^QR:to beg of text
4D19text beg = display beg ?
4D1F:yes
4D21no:redisplay all
4D24rewrite line
4D27text beg
4D2B-> current pos
4D2F-> display beg
4D33do selective redisplay
4D36restore line
4D39go to beg of line
4D3Cpos in line
4D40"reposition in line
4D43CR:carriage return
4D48:insert mode
4D4Ago down one line
4D4D'go to beg of line
4D50set flags: text changed
4D5Acurrent cursor pos
4D60set cursor to beg of line
4D63insert line break
4D6Asave current pos
4D6Brestore line
4D6Erewrite line
4D71restore current pos
4D72go down one line
4D75-> current pos
4D79go to beg of line
4D7Credisplay
4D7Fset new position
4D82indent ?
4D87:no
4D89up one line from curr pos
4D8C:no
4D8Eseparator: spaces only
4D91'go word right
4D96"do tab
4D99store pos in buffer
4D9Dreposition in line
4DA0selective redisplay
4DA3"restore line
4DA6^N:insert line - insert line break
4DA9row + 1
4DAFcol = 0
4DB1set cursor pos
4DB4current pos
4DB8go down one line
4DBBdisplay line
4DBE"restore line
4DC1Insert line break: rewrite line
4DC4InsLine
4DC7search end of line + 1
4DCBpos in buffer
4DD2relative pos in line
4DD7-> DX
4DD9current pos
4DDD+ relative pos
4DDFsave pos of line break
4DE0insert two bytes
4DE4do it
4DE7restore pos
4DE8store CR, LF there
4DED"
4DEE^S, ^H:character left
4DF2pos in line - 1
4DF3already at the beg ?
4DF9set new pos
4DFD"reposition in line
4E00^D:character right
4E04pos in line + 1
4E05= end of buffer ?
4E09below: ok, set it
4E0B"
4E0C^QP:to last position
4E0Fget pos from FIFO
4E13search beg of line
4E16-> current pos
4E1Aget display beg from FIFO
4E1E"redisplay
4E21^T:mark word - word right
4E24word left
4E27pos in line buffer
4E2Bchar = separator ?
4E2Eyes: word end found
4E30next char
4E31end of line ?
4E35:no, continue
4E37-> current pos
4E3Bmark block end
4E3Ego left one word
4E41"mark block beg
4E44get current pos
4E48go up one line
4E4Dsave pos
4E4Erewrite line
4E52set new pos
4E56set flag: short updating
4E5Bselective redisplay
4E5Erestore line
4E61search end of line
4E64'store position
4E66^A:word left
4E6Apos in buffer-1:search char<>sep
4E6B= line beg ?
4E6Fyes: go up one line
4E71char = separator ?
4E74yes: continue searching
4E76go back: search separator
4E77= line beg ?
4E7Byes: end it
4E7Dchar = separator ?
4E80:no
4E82go to left of word
4E83store pos in line
4E87get pos
4E8B"reposition in line
4E8E^F:word right
4E91end of line -> AX
4E93pos in line
4E97calc count
4E9B:ok
4E9Fflag: cursor past end of line
4EA3next char
4EA4end of line ?
4EA8:no
4EAAcurrent pos
4EAEgo down one line
4EB3rewrite line
4EB6current pos
4EBAgo down
4EBDnew pos
4EC1short update
4EC6redisplay
4EC9restore line
4ECCgo to beg of line
4ED3char = separator ?
4ED6:yes
4ED8'set that pos
4EDBchar = separator ?
4EDE:no
4EE0next char
4EE1end of line ?
4EE5:no
4EE7cursor past end of line ?
4EEC:yes
4EEEsearch end of line + 1
4EF2'set that pos
4EF4char = separator ?
4EF7:yes
4EF9"set that pos
4EFBcurrent pos
4EFFgo up one line
4F02"
4F03^I:Tab - go up one line
4F08save phys row
4F0Cpos in line
4F10store pos of upper line
4F14normal mode
4F19rewrite line
4F1Ccurrent pos
4F20save it
4F21go up one line
4F24store pos
4F28restore line
4F2Bsave ptr
4F2Fset sep ptr: spaces only
4F35word right
4F38restore sep ptr
4F3Crestore current pos
4F41restore phys row
4F44restore line
4F47flag: short update
4F4Cinsert ?
4F51:yes
4F53'rewrite line
4F56pos in line
4F5Apos in upper line
4F5Edifference
4F60not found: ret
4F62-> count
4F64save count
4F65insert a char
4F68space
4F6Brestore count
4F6Canother ?
4F6E:yes
4F70"rewrite line
4F73^QY:delete to end of line
4F77save pos in line
4F78test block markers in line
4F7Brestore pos
4F7Dend position
4F80fill up with spaces
4F83end reached ?
4F85:yes
4F87next char
4F88'
4F8Arestore pos in line
4F8B"redisplay line
4F8E^Y:delete line
4F91to line beg
4F95reposition in line
4F98delete to end of line
4F9Brewrite line
4F9Ecurrent pos
4FA2save it
4FA4go down one line
4FA7old pos
4FAAdifference
4FAC-> count
4FAErestore current pos
4FAF:erase the rest
4FB1'
4FB2remove from stack
4FB3"restore line
4FB6del line break: rewrite to BX
4FB9current pos
4FBDgo down one line
4FC0:ok
4FC2'restore line
4FC5go back two bytes
4FC7delete 2 bytes
4FCAclear carry
4FCCdo it
4FCFDelLine
4FD3get line cnt - 1
4FD8redisplay last line
4FDB"restore line
4FDE^T:delete right word
4FE1pos in buffer
4FE5> end ?
4FE9:delete line break
4FEBget char
4FEDspace ?
4FEF:delete spaces
4FF1separator ?
4FF4:end it
4FF6delete char
4FF9separator ?
4FFC:yes, end
4FFE"another char
5000current pos
5004up one line
5009line up
500Cgo to line end
500F'delete word
5011'
5012^G:delete right
5016'
5018DEL:delete left
501Cgo back one char
501Dbeg of line ?
5021yes: go to line above
5023store new pos
5027delete char
502Areposition on line
502D"redisplay line
5030Delete spaces
5033get char
5035space ?
5037:delete it
5039"redisplay
503BRedisplay: set cursor pos
503Ego down from display beg
5041get KBD stat
5046redisplay
5049:continue
504B"set cursor pos
504ERedisplay: set cursor pos
5051go down from display beg
5054redisplay
5057:continue
5059"set cursor pos
505Cgo down from display beg
5060count: first line to display
5062display beg
5066count down
5067:end it
5069go down one line
506E:another line
5070'
5071go to text end
5075"
5076do redisplay: go down
5079:ok
507Bgo to text beg
507Fdisplay from where ?
5083= line cnt ?
5089go down one more line
508D= phys row ?
5091yes: go down
5093current line
5096text end reached ?
509A:yes
509Cdisplay line
509Fnot yet end
50A0'
50A1NormVideo
50A4clear line
50A7not yet end
50A8'
50A9end it
50AA"
50ABredisplay one line
50ACline number
50AEgo down to this line
50B1restore
50B2"redisplay that line
50B4search beg of line: LF
50B6go back
50B7text beg ?
50BByes: end it
50BDbelow: next char
50BFtest char: LF ?
50C1no: continue searching
50C3next char
50C4"
50C5Skip CR
50C7no: ret
50C9get char
50CBnext char
50CCtext end ?
50D0no: continue
50D2"
50D3Clear line
50D4col count-1
50DA"clear line
50DDPrepare screen DMA
50DEDS -> ES
50DFptr to DMA buffer
50E3AL -> CX = pos in line
50E7AL*2 -> SI
50ECcolumn count * 2
50F1-> BP
50F3- horizontal offset
50F5line length * current row
50F9+ row position
50FB"
50FCcolumn + 1
50FEprepare DMA
5101char cnt-1
5102"do it
5104Display line
5105column count
5108prepare screen DMA
510Bcount down
510Chorizontal scroll
5110=0 ?
5114set attribute
5117get char
5119next char
511Atext end ?
511E:yes
5120skip CR
5123LF ?
5125:yes
5127another char ?
5129:yes
512Bcritical line
5130:no
5132save pos
5133search end of line
5136pos in line = end of line ?
513B:ok
513Dlimit it
5140pos: end of line
5144restore pos
5145set attribute
5148= pos EOL ?
514C:yes
514Eset attribute
5151end of line ?
5155yes: end
5157get char
5159next
515Atext end ?
515Eyes: end
5160CR ?
5162yes: forget it
5164control char ?
5166:no, normal
5168convert to normal
516Asave it
516Bset attribute
516Erestore
516Fcurrent attribute
5173store in buffer
5174:another char
5176get char
5179text end ?
517D:yes
517FLF ?
5181:not yet
5183one more byte
5184fill up with spaces
5186current attribute
518Cdisplay it ?
5191:no
5193byte number / 2 -> words
5197destination ofs
5199screen segment
519Dbuffer addr
51A5:yes
51A7just move it into screen memory
51A9'
51AAtest port
51ADget word
51AEsave it
51B0get status
51B3:wait
51B5no INT allowed
51B6get status
51B9:wait
51BBrestore char
51BCstore it
51BDclear interrupt
51BE:another char
51C0"
51C1Set attribute
51C6:block hidden
51C8block beg/end in this line ?
51CD:no
51CFblock begin ?
51D3:no, normal
51D5block end ?
51D9above: normal
51DB'in block !
51DD= pos block beg in buffer ?
51E1:no, normal
51E3> pos block end in buffer ?
51E7yes: normal
51E9display it ?
51EE:no
51F0'Attribute #2
51F3display it ?
51F8:no
51FA"NormVideo
51FDdisplay it ?
5202:no
5204"LowVideo
5207low set ?
520Cyes:NormVideo
520E"LowVideo
5210Clear line
5217save
5219line number+1
521Dprepare screen DMA
5220length-1
5221erase to end of line
5224restore
5226"
5227Scroll up
522Aset cursor pos: top line
522D"DelLine
5230^QL:restore line
5234clear block pos in buf:
5237block beg
523Bblock end
523Fup to 127 chars
5241dest: line buffer
5244flag: no block beg / end
5249get char
524Bblock beg ?
524F:no
5251pos block beg in line
5255block beg in this line
525Ablock end ?
525E:no
5260pos block end in line
5264block end in this line
5269CR ?
526Bno:next char
526Dstore a space
5270next
5271count down
5273:line too long
5275next char
5276end of text ?
527A:no, continue
527Cblock active in this line ?
5280:no
5282save pos
5283flag: block ends after
5286this line
528Bblock beg ?
5291flag: block starts before this
5294line
5298test line length
529Cstore old length
529Ffill up with spaces
52A5:again
52A7pos in buffer
52ABreposition in line
52AEsmall move only ?
52B3reset flag
52B8:yes
52BA'redisplay line
52BDredisplay from ...
52C2= phys row ?
52C6above: ret
52C8'rewrite line
52CBLF ?
52CDyes: end it
52CFstore char
52D1go to next
52D2too much ?
52D4:no
52D6'error: long line
52D8end of text ?
52DDyes: end it
52DF"continue
52E2Insert line break - line too long
52E5write message
5304wait for ESC
5307offset
530Ainsert line break
530Drestore line
5310"rewrite all
5313Clear status line
5316status line destroyes
531Bset cursor pos
5321NormVideo
5324clear line
5327set cursor pos
532D"LowVideo
5330Search end of input line
5332end pos
5335start pos
5338space ?
533Ano: end found
533Csearch backwards
533Dbeg reached ?
533Fno:continue
5341"
5342BX>end of line ?
5347:ret
534B"min(BX,DX)->BX
5351search end of line + 1
5352end position
5354pos block beg in buf
5358limit to end position
535Fpos block beg in buf
5363limit to end position
536Arestore end position
536C+1
536D- beg position
5372-> length
5373old length - new length
5378-> count
537C:ok
537Enegative
5380current pos
5384:no size change
5386expand / shrink text
5389restore length
538Adestination pos
538Ebuffer pos
5391count
5393test it
53950:nothing to do
5397get char
5399= block beg ?
539D:no
539Fset block beg
53A3= block end ?
53A7:no
53A9set block end
53ADstore char
53AFnext char
53B1another ?
53B3:yes
53B5go back one char
53B6store CR at end
53B9"
53BATest if memory full
53BEend text space - new text end
53C0:error
53C2254 bytes left ?
53C7or more: ret
53C9restore
53CCclear status line
53CFnumber free bytes
53D2write message
53DFdisplay number
53E2write message
53F3wait for ESC
53F6'
53F7clear status line
53FAwrite message
5411wait for ESC
5414"return to main loop
5417Test for interrupt
5419:not ^U - ret
541Bclear status line
541Ewrite message
5431wait for ESC
5434"go to main loop
5437Shrink or expand text
5438save pos,cnt
5439:insert, negative count
543B'delete, positive count
543Esave text end
5444text end - pos
5448-> BP
544Atext end
544Bsave (text end - pos)
544Ctext end - count
544E:error - out of space
5450-> BX
5452save new text end
5453test space free
5456restore new text end
5457restore count+1
5459text end
545Aset new text end
545Etest count
54600:no move to do
5462move block backwards
5465restore difference
5466pos
5469update pointers:
546Dblock beg
5478block end
5483display beg
548Epos current line
5499position FIFO
54A4pos FIFO 2
54AFsearch limit end
54BAsearch limit beg
54C1"
54C2update pointer: >pos of change ?
54C4below/equal: no change
54C6change it
54C8"
54C9Shrink text: save pos
54CA+ count
54CCsave
54CDtext end+1
54D2-pos-count
54D6-> move count
54D8restore source
54D9restore dest
54DAtest counter
54DC:nothing to move
54DEmove it - delete
54E1end pos-1
54E2set new end pos
54E6"update pointers
54E9Test block markers in line buffer
54EApos block beg in buffer
54EEmin(BX,DX)->BX
54F1block beg in this line ?
54F6:no
54F8set it
54FCrestore
54FDblock end in this line ?
5502:no
5504update it
550F"
5510Reposition in current line
5513ptr line beg
5514column count - 1 -> CL
551Brelative pos -> BX
551Fpos < hor scroll ?
5523yes: underflow
5525outside displayed window ?
5527no: ok
5529calc diff+1 (overflow)
552Dadd to horizontal scroll
5535col cnt-2 -> phys col
553F'redisplay all
5542store phys col
5545'
5546add to horizontal scroll
554Dphys col 0
5552"rewrite all
5555Do selective rewrite
555Cdisplay beg
5560text beg
5563the same ?
5565:yes
5567store to display beg
556Cline cnt
556Fcurrent pos
5573= display beg ?
5575:no
5577'yes: done
557Abelow: search down
557Ccurrent pos
5580= ?
5584go up one line
5587count it
5588'
558Astore display beg
558Ephys row
5593set flag
559Brow cnt - 1
55A1= line ?
55A3below: ok
55A5go back one line
55A6set cursor pos:
55A9below status line
55ACtest it
55AErestore
55AFInsLine
55B2:again
55B4one only ?
55B5no: do redisplay
55B7'
55B8'redisplay all
55BB>= current pos
55BF:not yet
55C1go down one line
55C4count
55C5'
55C7clear count
55C9:much
55CCline count-1 -> DL
55D3counter-line cnt+1 -> DH
55DB:ok
55DDtest it
55E1test flag
55E6:normal
55E8'keep it short
55F1redisplay from
55F8set it
55FBdisplay beg
5602go down one line
5605save pos
5606scroll up
5609restore
560Acount down
560C:another
560Estore display beg
5615phys row
5619'
561E'
5624line cnt - 3 -> DL
5636go down one line
5639:again
563Bstore display beg
563Fredisplay all
5642set flag: long update
5647'do it again
564Aset phys row
564Dredisplay from
5651= line cnt ?
5655:yes
565Bset: redisplay from
565Edisplay beg
5662go down one line
5665-> new display beg
5669scroll up
566Dline cnt - 1
5672"redisplay one line
5675Char = separator ?
5679get ptr to table
567Aget char from table
567Ctable end ?
567E:yes
5680= text char ?
5682:yes
5684try next char
5685'
5687found it !
5688DX=pos in table
568A"
568Bredisplay current line
568Csave
568Dphys row
5690>= redisplay from ?
5694:ok
5696redisplay current line, too !
5699restore
569B"
569Cset flag: redisplay all
56A1"
56A2Update blocks
56A4block beg in this line ?
56A9:no
56ABpos block in buffer
56AF< BX ?
56B1:ok
56B3add count
56B5-> update
56B9block end in this line ?
56BE:no
56C0pos block end in buffer
56C4< BX ?
56C6:ok
56C8add count
56CA-> update
56CErestore BX
56D0"
56D1delete char: save pos
56D21 char back
56D5update blocks
56D8pos -> DX
56DAbuffer end
56DDcalculate count
56DF:nothing to move
56E1count -> CX
56E3pos -> BX
56E5source: +1
56E6move it
56E9store a space at the end
56EFrestore pos
56F0"
56F1min(BX,DX) -> BX
56F3max(BX,DX) -> DX
56F7"
56F8redisplay line: set cursor pos
56FCcol cnt - 1
5701- phys col
5705pos in line buffer
5709attribute change in this line
570Eredisplay this line
5711clear attribute flag
5716"
5717go down one line
5719text end
571Dcurrent pos
571Ftext end-pos -> count
5721:too much
5723DS -> ES
5727search LF
572C:not found
572Erestore CX
5730pos of line break
5732'
5733restore CX
5735flag: not done
5736"
5737go up one line
5739search LF
573Btext beg = limit
573Fgo back one char
5740go back
5741= end ?
5743:yes
5745LF ?
5747:no, try again
5749go to beg of line
574A:not found
574C'
574Drestore pos
574F"
5750insert char in line
57511 char
5754update blocks
5757buffer end
575Acalc count
5761buffer end
5767test length
5769did they translate this automatically
576Bfrom Z80-code ??!!
576Dsave pos
576Einsert
5771restore pos
5772store a space
5775restore pos
5776"
5777Write string + pos cursor
577ALowVideo
577D"write string
5780Attribute #3
5783"write string: error message
5786editing status
578B:ret
578D"write it
5790Get KBD stat
5795do it
579D"
579Eset cursor pos
57A5line
57ABset it
57AErestore
57B0"
57B0first command table (installed with TINST)
5875"
5875second command line (preinstalled)
58E9"
5903"
5903Jump table for editor commands
5903Labels ending with 2 have the MSB set. On these commands
5903the text is marked as changed. The commands are in the order
5903given in the chapter "Editing Command Installation" of the
5903Turbo manual.
5953"
5960*** Compiler ***
5961save stack pointer
5965to COM or CHN ?
596A:no
596Cis it already compiled ?
5971:no
5973is it invalid ?
5978:yes
597Aopen dest file
597Dchange to disk code
5980'no error
5982init variables
5985to memory ?
598A:no
598Cmake space, copy run-time lib
598F'
5991COM / CHN ?
5996:no
5998open dest file
599Bcompile program
599Ememory ?
59A3:no
59A5set flag: compiled
59AA'
59ACCOM / CHN ?
59B1:no
59B3flush code buffer
59B8"return: no error
59BBInit variables: not compiled
59C0code invalid
59C5store ^Z at source end
59CC(size/16)+1+DS
59D5-> code dest segment
59D8free memory - size
59DD-> minimum stack size
59E0stack pointer - 1024
59E8-> end of patch list space
59EC- 1024
59F0-> top of patch list
59F4-> beg of patch list
59F8destination for var table
59F9copy std vars into symbol table
59FCSS -> ES
5A00save DS
5A01CS -> DS
5A05count
5A0Brestore DS
5A0D-> top of symtab
5A15-> current var fence
5A19patch in ptrs to type defs
5A20pointer
5A22+ offset
5A25next one
5A26:another one
5A28text beg
5A2B-> src ptr
5A2Eline buffer
5A31-> char ptr
5A35clear line
5A38clear vars:
5A3Arecord nesting
5A40lexical nesting
5A43not end of source
5A46no PUSH AX
5A49no PUSH ES
5A4Cno PUSH DI
5A4Fuser int not used
5A52no overlays used
5A55no include
5A58code ptr
5A5Bcode pos in buffer
5A5Ebeg of code buffer
5A61current file offset
5A67line counter
5A6Astd in buffer size
5A6Dstd out buffer size
5A70max 16 open files
5A76counter for scalar types
5A7Bset compiler directive
5A81display line, test brk
5A84PC: start of code
5A8ADC: start of file list
5A90COM ?
5A95:yes
5A97CHN:ret
5A99code pos of buffer
5A9F'
5AA0code ptr
5AA6code pos of buffer
5AAC"
5AADTest for memory overflow
5AB3(../16)+1
5AB8+ dest segment
5ABC(symtop/16)+SS
5AC6compare them
5AC899:compiler overflow
5ACCclear addr
5AD0dest seg
5AD4save DS
5AD5CS -> DS
5AD7copy runtime library into code
5ADDrestore DS
5ADE"
5ADFOpen dest file
5AE1no attribute
5AE3dest name ptr
5AE6DS -> ES
5AE8create it
5AEFstore file handle
5AF2COM file ?
5AF7:no
5AF9file handle
5AFBwrite byte block
5AFDsize of runtime code
5B00offset
5B03save DS
5B04CS -> DS
5B06write runtime library
5B09restore DS
5B0A:error
5B0Clength = expected ?
5B0Eno: error
5B10'
5B11C9:dest file not written
5B14"
5B15Change mem code to disk code
5B16save DS
5B17DS -> ES
5B18code dest segment
5B1Cptr to memory parameters
5B1Fdest: buffer
5B227 words
5B27move it into buffer
5B28DS -> ES
5B2Arestore DS
5B2Bptr to memory parameters
5B2Fclear direct mode
5B33code size > min CS size ?
5B3A:ok
5B3Cat least min CS size
5B40store CS size
5B43data size > min DS size ?
5B4A:ok
5B4Cat least min DS size
5B50store DS size
5B53min free heap
5B57-> heap, stack size
5B5A> max free heap ?
5B5E:yes
5B60take that size
5B64store max heap,stack size
5B67Write code to disk
5B69dest file handle
5B6Dcode end
5B71offset: end of run-time
5B74calc length
5B76save DS
5B77ES -> DS
5B79write it
5B7Crestore DS
5B7Dsave results
5B80restore memory code
5B8A7 words
5B8Edo it
5B90restore results
5B93:error
5B95length = expected ?
5B97:no
5B99'
5B9AC9:file error
5B9D"
5B9ECompile program: get word
5BA1PROGRAM ?
5BA6:no
5BA8read dummy symbol
5BAB( ?
5BAE:no
5BB0read dummy symbol
5BB3, ?
5BB6yes: repeat
5BB8! )
5BBB! ;
5BBE* CALL initmem
5BC1emit CALL
5BC4set mode flag
5BC6to memory ?
5BCB:no
5BCDflag: direct mode
5BD0device checking ?
5BD6:no
5BD8set flag
5BDBtest ^C and ^S ?
5BE1:no
5BE3set flag
5BE6save flag
5BE7save code ptr
5BEBemit mode flag
5BEEemit Turbo CS
5BF3emit Turbo DS
5BF8save code ptr
5BFCemit 4 dummy words:
5BFFmemory size is not yet known
5C08max number of open files
5C0Badd to data counter
5C0F(file handle list)
5C13emit file count
5C16std in buf size
5C19add to DC
5C1Demit
5C20std out buf size
5C23add to DC
5C27emit
5C2A* MOV BP,SP
5C30clear var space used
5C36emit overlay uncrunch
5C39declaration part
5C3Cprogram part
5C4A* XOR AX,AX
5C50* CALL progend
5C56end overlay crunch list
5C59(PC+15)/16
5C63-> CS size
5C66(DC+15)/16
5C70-> DS size
5C73code ptr: memory sizes
5C74CS size > min CS size ?
5C7B:ok
5C7Dat least min CS size
5C80patch in
5C85DS size > min DS size ?
5C8C:ok
5C8Eat least min DS size
5C91patch in
5C96min free heap
5C99COM / CHN ?
5C9E:yes
5CA0min stack size
5CA3- code size - data size
5CAB-> min stack size
5CAEsave it
5CAFpatch in
5CB2restore
5CB5> max free heap size ?
5CB9:ok
5CBBat least max free heap
5CBEpatch in
5CC1code ptr mode flag
5CC2flag
5CC3user interrupt used ?
5CC8:no
5CCAset flag: user interrupt
5CCDpatch in
5CD0"patch code in file
5CD3read dummy symbol
5CD7read symbol
5CDArestore symtob: forget symbol read
5CDE"
5CDFTest for overflow
5CE1save regs
5CE2to memory ?
5CE7:no
5CE9(PC/16)+1
5CF1+(DC/16)+64
5CFE>= free memory ?
5D0298:memory overflow
5D06'ok
5D08code ptr
5D0B-code pos of buffer
5D0F+beg of code buffer
5D13convert to paragraphs
5D18+ dest segment
5D1C+ spare
5D1F(symtab top/16)+SS
5D29crash ?
5D2B:no
5D2Dsave
5D2Eflush code buffer
5D3199:compiler overflow
5D35restore
5D36restore regs
5D39"
5D3Avalid symbol char ?
5D3C:no
5D3EA..Z ?
5D41:ok
5D43_ ?
5D45yes: ok
5D47a..z ?
5D49:no
5D4E"
5D4Fvalid alphanumeric char ?
5D52:ok
5D540..9 ?
5D56:no
5D5B"
5D5CError if below: store error pos
5D60:no error
5D62'
5D64Error if not below
5D68:no error
5D6A'
5D6CError if equal
5D70:no error
5D72'
5D74Error if not equal
5D78:error
5D7Ano error: skip inline parameter
5D81'
5D82store error position
5D86Error: get return addr
5D88get error number (inline)
5D8Astore it
5D8Dwrite line number
5D90test error
5D92:no error
5D94calculate error position
5D97pos in buffer - buffer beg
5D9Ainclude file ?
5D9F:yes
5DA1- text beg
5DA5+ beginning of source line
5DA9'
5DABpos of line begin
5DAFstore relative error pos
5DB2close all files
5DB7restore stack pointer
5DBB"return to user-interface
5DBCDefinition part: save code pointer
5DC0* JMP ....
5DC3save PC
5DC7search keyword
5DCAoffset between keywords
5DCBkeyword pointer
5DCDnot found ?
5DD012:BEGIN expected
5DD1LABEL ?
5DD3:no
5DD5do label
5DD8'next def
5DDACONST ?
5DDC:no
5DDEdo const
5DE1'next def, already searched
5DE3TYPE ?
5DE5:no
5DE7do type
5DEA'next def
5DECVAR ?
5DEE:no
5DF0do var
5DF3'next def
5DF5OVERLAY ?
5DF7:no
5DF9do overlay
5DFC'next def
5DFEBEGIN ?
5E00:yes
5E02flag: not overlay procedure
5E07do procedure / function def
5E0A'next def
5E0Cresolve forward definitions
5E0Frestore beginning PC
5E10new PC
5E13calc offset
5E15code ptr of beginning
5E16+1: offset
5E17"patch it
5E1Aemit code for overlay uncrunch
5E1D* CALL uncrunch
5E20code ptr
5E23-> link
5E26emit it (dummy)
5E29PC+2
5E2E"emit it
5E31do overlay uncrunch list
5E35code ptr
5E38- pos old link
5E3Apatch offset
5E3Demit a zero:
5E3F"current end of the list
5E42label definition
5E45store word in symtab
5E48current pos
5E4Cget char
5E4Ein alphanum ?
5E51get sym - numbers allowed
5E54lexical nesting
5E58flag: unresolved
5E5Astore word
5E5Dstore dummy: offset
5E60write symtab offset
5E63, ?
5E66yes: do another definition
5E68"! ;
5E6BConstant definition
5E6Ftag: invisible
5E71store in symtab
5E74get symbol name
5E77= ?
5E7Ano: structured constant
5E7Cread constant
5E7Ftype
5E81store in symtab
5E84real ?
5E87:no
5E89store real number in symtab
5E8C6 bytes
5E9B'do end of entry
5E9Dstring ?
5EA0:no
5EA2buffer pointer
5EA5get length
5EA7counter
5EA9store byte in symtab
5EACget next char
5EAFanother ?
5EB1:yes
5EB3'do end of entry
5EB5integer constant: result -> AX
5EB6store in symtab
5EB9write symtab offset
5EBCset tag: normal constant
5EBE'do it
5EC0! : (structured constant)
5EC3save symtab pos
5EC7store dummy type
5ECAstore offset in symtab
5ED0segment CS
5ED6write symtab offset
5ED9get type
5EDCrestore symtab pos
5EDDstore type ptr
5EE3! =
5EE6read structured constant
5EE9tag: structured constant
5EEBrestore symtab pos
5EECset tag byte: entry type
5EEF! ;
5EF2search keyword: definitions
5EF8:found, exit
5EFA'do another const definition
5EFD"
5EFEread structured constant
5F01test component type
5F03:ok
5F05file / pointer ?
5F07:no
5F0961:Files and pointers
5F0C'are not allowed here
5F0Darray ?
5F0F:no
5F11save entry to stack
5F14index type
5F18get parameters
5F1Bupper bound - lower bound + 1
5F23save count
5F24component type pointer
5F28get parms
5F2Brestore count
5F2Carray of char ?
5F31:no
5F33test count
5F35:more than 256
5F37( ?
5F3Ano: defined by string constant
5F3C'
5F3E! (
5F41save count
5F42read structured constant (recursive !)
5F45restore count
5F46count down
5F47:done
5F49! ,
5F4C'do next entry
5F4Esave count
5F4Fread constant
5F52restore expected length
5F53= length read ?
5F5550:String const length does not
5F58match type
5F59emit string (without length byte)
5F5C'done
5F5E! )
5F61restore entry
5F64'
5F65record ?
5F67:no
5F69save entry to stack
5F6C! (
5F6Frecord nesting level
5F73save component size
5F77offset in record: size done
5F79save nesting, size
5F7Bsearch variable
5F8041:Unknown ID or syntax error
5F84get parms
5F87restore size
5F88= offset of record sub-var ?
5F8C69:Invalid ordering of fields
5F90add size to offset
5F94save it
5F95! :
5F98read structured constant
5F9B, ?
5F9Erestore size, nesting level
5FA0yes: continue
5FA2save size
5FA3! )
5FA6current size
5FA7component size of record type
5FA8compare them
5FAA:ok
5FACemit zeroes to fill
5FB1:another
5FB3restore entry from stack
5FB6'
5FB7set ?
5FB9:no
5FBBsave entry to stack
5FBEsave component size
5FC2type ptr
5FC6get type parms
5FC9! [
5FCCbuffer ptr
5FCFDS,DI: dest ptr
5FD1make empty set (on stack)
5FD4] ?
5FD7:yes
5FD9get scalar element
5FDCsave
5FE2:no
5FE4get scalar element
5FE7include range in set
5FEA'
5FECrestore scalar element
5FEDinclude element in set
5FF0, ?
5FF3yes: continue
5FF5! ]
5FF832 bytes
5FFBstore set into buffer
5FFEcrunch set constant:
6002(lower bound)/8
6006+ buffer offset
600Arestore component size
600Bget byte
600Demit it
6010next one
6011:another
6013restore entry from stack
6016'
6017string ?
6019:no
601Bread string constant
601Ecomponent size - 1
6024>= actual size ?
6026:ok
6028limit to max size
602Cnothing to fill up
602Eemit string
6031fill up ?
6033:no
6035emit zeroes to reserve space
603Aanother ?
603C:yes
603E'
603Freal ?
6041:no
6043get numeric constant
6046real ?
6049:ok
604Binteger ?
604E25:Integer or real const expected
6052get result
6053convert to real
6056store it in buffer
6061emit resulting real number
6070'done
6073integer: get scalar element
6076component size = 1 ?
607B:yes
607D'emit word
6080"emit byte
6083get scalar element
6086= component type ?
608A44:Type mismatch
608Eresult -> AX
608F< lower bound ?
6093:yes
6095> upper bound ?
6099:yes
609B'
609C45:Constant out of range
609F"
60A0Type definition
60A4save symtab top
60A8tag: invisible
60ABstore in symtab
60AEget symbol
60B1save symtab top
60B5store dummy
60B8write symtab offset
60BB! =
60BEget type
60C1restore pos
60C2store type ptr
60C8pos of tag
60C9set tag: type definition
60CD! ;
60D0search keyword: definitions
60D6not found: another type def
60D8old symtab top -> type fence
60DCsave next element
60DDfill in pointer types
60E0restore next element
60E1"
60E2Var definition: define var
60E5! ;
60E8search keyword: definitions
60EEnot found: another var
60F0"
60F1Overlay: always recompile
60F6get filename
60F9end pos
60FBget char
60FDend ?
60FF:yes
6101. ?
6103:no
6105remember end pos
6107next char
6108\ ?
610Ano: loop back
610Cset beg position
610Eclear end position
6110'loop
6112end position set ?
6114:no
6116set it
6118too much ?
611C92:Unable to create overlay file
6120overlay counter
6123clear high byte
6125count up
612Dget 10-digit
6131-> ASCII
6134store number
6137mark end
613B* CALL readovr
6141invalid overlay in mem
6144emit word
614713 bytes
614Aemit file name
6150:another
6152patch code in file
6155flush code buffer
6158save code destination
615Csave dest file handle
6160save code ptr
6164save code pos buf beg
6168save beg of buf
616Csave current offset in file
6174save uncrunch link
6178save max length of overlay part
617Ccompile to memory ?
6181:no
6183set: to COM
6188code ptr - code pos of buffer
618Badd to beg of code buffer
6193length = 0
6198no offset in file
619Efind error ?
61A5create file
61A7no attribute
61A9name ptr
61ACDS -> ES
61AEopen it
61B192:Unable to create overlay file
61B5store dest file handle
61BAclear code ptr
61BDcode pos of buffer
61C0search key word
61C3(procedure or function)
61C616:PROC or FUNC expected
61CAsave PC
61CEsave code ptr
61D2save keyword
61D3emit overlay uncrunch code
61D6restore keyword
61D7set flag: in overlay
61DCdo proc/func
61DFend overlay uncrunch list
61E2patch code in file
61E5restore code ptr, PC
61E7save
61E8new - old code ptr
61EDemit zeroes, until length
61EFa multiple of 256
61F6'
61F8restore
61F9store code pos in proc def
61FCadd to pos in file
6205PC - old PC
620Arestore old PC
620E>= previous procedures ?
6212:no
6214set as max length
6217flush code buffer
621AOVERLAY ?
621Fyes: repeat
6221find error ?
6226yes: no file
6228close file
622Afile handle
6231get maximum length
6235restore variables
6239same as above
6256restore code destination
6259max length + PC
625Duncrunch link
6261code ptr -> uncrunch link
6267code pos - link
6269patch link
626Cemit word
626Fmax length + PC
6271emit word
6274set new PC
6278"
6279define proc / func: set flag
627C-> type
6280save type
6281search
6285not found: new definition
6287'complete forward definition
628Astore tag word in symbol table
628Dget symbol
6290save current var fence
6294current sym top
6297-> new var fence
629Asave symtab pos
629Emake space
62A3test overflow
62A6size of stack frame
62A9parameter counter
62AB( ?
62AEno:no parms
62B0save
62B2save symtab pos
62B6make space
62BBtest overflow
62BEVAR ?
62C3normal: 0
62C6no: normal
62C8flag: FF00
62CAsave flag
62CBread symbol
62CErestore type
62CFcount vars of same type
62D1, ?
62D4yes: repeat
62D6save count
62D7VAR-parameter ?
62D9:yes
62DB! :
62DE'
62E0: ?
62E3yes: ok
62E5bottom of symtab
62E8point to untyped var
62EB-> type ptr
62EE'
62F0set VAR flag
62F4get type
62F7limit component size
62FArestore type, count
62FBrestore symtab pos
62FCtype ptr
62FF-> type
6302store count
6305component size
6308VAR-parameter ?
630A:no
630Csize 4: pointer
630Fclear hi
6311count * component size
6314restore
6315add to size of stack frame
6317count entries
6319semicolon ?
631Cyes: another parm
631E! )
6321write symtab offset
6324function ?
6329:no
632B! :
632Esave parm count,
632Fstack frame size
6330clear flag: normal var
6335get type
6338restore
633Alegal type ?
633F:no
6341pointer ?
634648:Invalid result type
634Asymtab ptr
634Cget type ptr
634Fstore it
6352store stack frame size
6355lexical nesting level
6359+1
635Dstore segment
6360add to size of stack frame
6364! ;
6367restore symtab ptr
6368restore var fence
636Cget PC
636Foverlay procedure ?
6374:no
6376entry code...
6379store position
637Cstore stack frame size
637Fstore param count
6384position in overlay file
638Ano forward
638Foverlay procedure ?
6394:yes
6396FORWARD ?
639B:no
639Dremember code position
63A0for patching
63A3set flag: forward def
63A6emit jump
63A9'! ;
63ACEXTERNAL ?
63B1:no
63B3'do external procedure
63B6complete forward definition
63BAtest flag. Defined:
63BD43:Duplicate ID or label
63BEoverlay procedure ?
63C3yes:
63C676:Overlays cannot be forwarded
63C7skip spaces
63CA! ;
63CDclear forward flag
63D1get addr of forward jump
63D5PC-proc pos-3 -> offset
63DEpatch it in
63E1save memory usage
63E5save fence
63E9symtab top
63EC-> current fence
63EFsave pos in symtab
63F0get stack frame size
63F3procedure ?
63F8:yes
63FAsubtract size of result
6401-> memory usage
6404inc nesting
640Cparameter count
640Fpos
6414all parms done ?
6416:yes
6418save count
641Aget variable pointer
641Dsave current pos
641Eset type ptr
6422get var parms
6425restore pos
6427get type
6430save type
6431save symtab top
6435go down
6438symtab top
643Estore: var
6446get length
6448store length
644Bgo down
644Eget char
6450store it
6453another ?
6455:yes
6457go down
645Aset new symtab top
645Ewrite offset
6461:another var
6463restore pos
6464restore count
6466store offset, segment
6469scalar var: 2 bytes on stack
646Cdo var definitions
646Frestore pos, cnt
6471another ?
6473'
6475emit stack frame code
6478* PUSH BP
647Alexical nesting = 1 ?
647F:no
6484* MOV BP,SP
6487'
6489complicated - do display
648C* MOV AX,SP
6491lexical nesting -> count
6497* PUSH [BP+..]
649Dcount down two bytes
64A1offset into display
64A3emit offset
64A6another level ?
64A8:no
64AD* MOV BP,AX
64B0now push current display !
64B3* PUSH BP
64B5lexical nesting * 2
64BE-> stack usage
64C2proc or func ?
64C5save flag
64C6do definition part
64C9restore... (defs may be recursive)
64CEmem usage - current
64D2make space on stack
64D5restore symtab ptr
64D7store memory size
64DAmemory usage
64DFadd to mem size
64E298:Memory overflow
64E6do program part
64E9restore memory size - 4
64EDfunction ?
64F2:no
64F4restore symtab pos
64F6save mem size
64F7get var parms
64FAflag: not indexed
64FFmem size
6500component type = real ?
6505:no
65076 bytes on stack
650A'
650Cstring ?
6511:no
6513- component size -> pos on stack
6517* MOV DX,..
651Acomponent size: max length - 1
651Emax string length
6520* MOV CL,..
6525* MOV SP,BP
6528* POP BP
652C* JMP retstr
6532'
6534save pos
6535load var
6538restore
6539boolean ?
653E:no
6540* OR AX,AX (set flags)
6546* MOV SP,BP
6549* POP BP
654Dstack frame ?
654F:yes
6551none:
6554* RET
6556'
6558remove stack frame
655B* RET ....
655Demit stack frame size
6560! ;
6563restore symtab pos
6564clear flag
6567restore lexical nesting
656Bfence -> symtab top
656E= remove all local vars
6574restore fence
6578restore mem usage
657C"
657Dread external proc
657Etag: procedure
6584: found
6586tag: function
658C:not found
658Eget offset
6591! [
6594get integer constant
6597! ]
659Aoffset + number
659D'-> offset of this proc
659Fsave PC
65A3read string constant
65A6length
65AAstore a 0 at the end
65AFname ptr
65B2extension .COM
65B5parse filename
65B8open file
65BBname ptr
65BEDS -> ES
65C0open it
65C390:File not found
65C7file handle
65C9read from file
65CB128 bytes
65CEdest buffer
65D1do it
65D490:File not found
65D8length read -> CX
65D90: end
65DBsource ptr
65DEget byte from external file
65E0and emit it
65E3next one
65E4:again
65E6'try another block
65E8close file
65EDrestore offset
65EErestore symtab pos
65EFstore offset
65F2"! ;
65F5scalar var ?
65FA:no
65FCon stack at least 2 bytes
6602"
6603Resolve forward definitions
6607= var fence ?
660Byes: end
660Dgo to next entry
6610function ?
6614:yes
6616procedure ?
661A:no, next one
661Centry ptr
6622length of name
6626go down
6629defined ?
662Dno:
663073:Undefined FORWARD procedure
6631'next one
6633"
6634define var: clear VAR-flag
6639get variable list
663Csave counter
663Dsave symtab ptr
663E! :
6641get type, test absolute
6644restore
6646component size
664AVAR-parameter ?
664F:no
6651yes: pointer !
6654var offset
6657absolute ?
665C:yes
665Erecord nesting level ?
6663:in record
6665inside procedure ?
666A:yes
666CDC -> offset
666Fadd size to DC
6673overflow:
667698:Memory overflow
6677'
6679go down (stack !)
667Doverflow ?
668098:Memory overflow
6681get offset
6684'
6686get offset
6689add to var space
668Doverflow ?
669098:memory overflow
6691go down in var list
6694get length
6699go down
669Bstore offset
669Estore segment
66A4store type ptr
66AAmake space
66ADanother definition ?
66AF"test for overflow
66B2get variable list
66B6clear counter
66B8save
66B9tag: var, record nesting
66BEstore in symtab
66C1store name in symtab
66C4reserve some space
66C9write symtab offset
66CCrestore counters
66CE, ?
66D1yes: next var
66D3restore symtab pos
66D4"(beginning of list)
66D5get var type, test ABSOLUTE
66D9read type
66DCsymtab top -> type fence
66E0fill in pointer types
66E3ABSOLUTE ?
66E8:no
66EAset flag
66EFin record ?
66F4yes:
66F775:Illegal use of ABSOLUTE
66F8search var
66FE:not found
6700get offset
6703get segment
6706'store parms
6708read constant -> segment
670B:no good
670Dtest type: integer
6710save segment
6711! :
6714get integer constant
6717get PC: pos of pointer
671Cemit result = offset
671Femit segment
6723flag: CS indirect
6726'
6728DSEG ?
672Dflag: DS
6730:yes
6732CSEG ?
6737flag: CS
673A:yes
673C'Unknown ID or syntax error
673Fsave segment flag
6740! :
6743get integer constant
6746restore segment
6747offset -> DX
674D'
674Fclear absolute flag
6754VAR-parameter ?
6757lexical nesting
675Binside proc ?
675D:yes, use stack segment
675Fdata segment
6761store segment
6764"
6765Test file type: search type
6768:found
676ATEXT ?
676F:no
6771get ptr to that type
6774'
6776FILE ?
677Bno:
677E36:Type ID expected
677Fpoint to typed/untyped file
6782VAR-parameter ?
6787yes: ok
6789typed file ?
678E:below
6790above file ?
6795yes: ok
679A"67:Files must be VAR parameters
679BFill in pointer types
679F= type fence ?
67A3yes: done
67A5go to next var
67A8subtype ?
67ACno: next one
67AEmake it invisible
67B2pointer ?
67B6no: next one
67B8filled in ?
67BC:yes
67BEflag: filled in
67C2get pos of type name
67C6name length
67CB-> count
67CCsave pos
67CDsearch from top
67D1bottom of symbol table ?
67D5yes: error
67D7go to next var
67DAtype ?
67DE:no, search next
67E0pointer
67E4pos of searched string
67E6len -> count
67E8go back
67EBcompare chars
67F0:not the right one
67F2:test another char
67F4restore symtab pos
67F6get type pointer
67F9store into pointer entry
67FC'next one
67FE'
67FF42:Undefd ptr type in preceding
6802"type defs
6803get type: search type ID
6806found: ret
6808PACKED ?
680B(ignored)
680Darray ?
6810:done
6812record ?
6815:done
6817set ?
681A:done
681Cpointer ?
681F:done
6821file ?
6824:done
6826text ?
6829:done
682Bstring ?
682E:done
6830scalar list ?
6833:done
6835subrange ?
6838:done
683A36:Type identifier expected
683D'
683E"
683Fsearch type
6845:not found - ret
6847type pointer
684Astore it
684Eget type parms
6851ok
6853"
6854ARRAY ?
6859:no
685B! [
685Eclear dimension count
6860save
6861get scalar type
6865save type pointer: index type
6869upper bound - lower bound
6870+ 1
687198:Memory overflow
6875save component count
6876count dimensions
6877, ?
687Ayes: another dimension
687Csave dim count
687D! ]
6880! OF
6883get type
6886dim count
6887type ptr
688A-> type
688Dcomponent size
6890* component count
6893too much ?
689698:Memory overflow
6897-> component size
689Aindex type
689Bstore it
689Etag: array
68A3store type
68A6:another dimension
68A8"
68A9RECORD ?
68AEno: ret
68B0save variant rec nesting
68B4save rec nesting
68B8one more level
68BCrecord counter
68BF-> record number
68C2save space used
68C6save max size of variant rec
68CAclear them
68D6no variant record
68DBdo record definition
68DEmax component size
68E1-> variable size
68E4restore vars
68ECrecord number
68EF-> subtype
68FAtype: record
68FFstore type
6902"
6903do record def: test end
6906yes: ret
6908CASE ?
690D:yes
690Fdefine variables
6912memory used
6915>= max size ?
6919below: forget
691Bstore as new max size
691Esemicolon ?
6921yes: loop back
6923'end it
6925variant record: search type
6928:found
692Adefine var: tag field
692D! OF
6930test for end
6933yes: ret
6935save mem used
6939get constant
693C, ?
693F:another constant
6941! :
6944! (
6947save variant rec flag
694Bset it
6950do type definition list
6953restore flag
6957restore memory used
695Bsemicolon ?
695Eyes: another
6960variant record ?
6965:no
6967'! )
696AEND ?
696Fno:
697214:END expected
6973"
6974test end
6979:normal rec
697B'in variant rec: ) ?
697EEND ?
6983"
6984SET ?
6989no: ret
698B! OF
698Eget scalar type
6991upper bound
6994lower bound
6998one of them > 255 ?
699Cyes:
699F70:Set base type out of range
69A0calculate component size
69A2(upper/8)-(lower/8)+1
69AB-> component size
69AEtype ptr
69B1-> type
69B4tag: set
69B9store type
69BC"
69BDpointer: prelim def
69C0ptr ? no: ret
69C2tag: invisible
69C5store in symtab
69C8save pos
69CCget name of ptr
69CFwrite symtab offset
69D2restore pos of prelim offset
69D6tag: pointer
69DBflag: not fully defined
69E0size: 4 bytes
69E6store type
69E9"
69EAFILE ?
69EFno: ret
69F1OF ?
69F6no: untyped file
69F8read type
69FBcomponent type = file ?
6A00:no
6A07:no
6A09yes:
6A0C'68:File components may not be files
6A0Dtype ptr
6A10store it
6A13typed file
6A18set size
6A1Estore type
6A21'
6A22untyped file
6A26point to it
6A2A"standard type
6A2DTEXT ?
6A32no:ret
6A34[ ?
6A37no: standard text file
6A39get integer constant
6A3Cbuffer size = 0 ?
6A3Eyes:
6A4145:Constant out of range
6A42! ]
6A45add size of file var
6A48-> var size
6A4Ctext file
6A51store type
6A54'
6A55set ptr to std TEXT file
6A5D'standard type
6A60STRING ?
6A65no: ret
6A67! [
6A6Aget integer constant
6A6D> 255 ?
6A6Fyes:
6A7249:Invalid string length
6A73length = 0 ?
6A75yes:
6A7849:Invalid string length
6A79! ]
6A7Clen+1 (for length byte)
6A7D-> component size
6A81tag: string
6A86store type
6A89"
6A8Ado scalar list
6A8D( ? no: ret
6A8Finit counter
6A93tag: const
6A96store tag word
6A99read symbol
6A9Cnumber of scalar type
6A9Fstore (elementary type)
6AA2restore counter
6AA3inc it
6AA4save it again
6AA5store value of that const
6AA8write symtab offset
6AAB, ?
6AAFyes: another element
6AB1! )
6AB4number of this type
6AB8count scalar types
6ABCclear lower bound
6ABEstore component type
6AC2store upper bound
6AC6store lower bound
6ACAbyte possible ?
6ACCsize = 1
6ACFyes: ok
6AD1size = 2
6AD2store component size
6AD5store type
6AD8"
6AD9do subrange: read constant
6ADCno good: ret
6ADEsave type, result
6AE0scalar ?
6AE3no:
6AE651:Invalid subrange base type
6AE7.. ?
6AECno:
6AEF11: .. expected
6AF0get constant
6AF3restore component type
6AF4restore lower bound
6AF5same component type ?
6AF7no:
6AFA44:Type mismatch
6AFBupper >= lower ?
6AFDyes: ok
6AFF52:Lower bound > upper bound
6B02'
6B03"
6B04get scalar type: do subrange
6B07done: ret
6B09do scalar list
6B0Cdone: ret
6B0Esearch type
6B11complex ?
6B1430:Simple type expected
6B15scalar ?
6B1A:yes
6B1C30:Simple type expected
6B1F'
6B20"
6B21Program part
6B26no with nesting
6B2Bdo block
6B2Esave PC: jump to end of exit codes
6B32emit jump
6B39= actual symtab top ?
6B3Dyes: end it
6B3Fget dest addr
6B42exit ?
6B44:yes
6B47get dest offset (from label)
6B4Blabel defined ?
6B4Eno:
6B5140:Undefined label
6B55'patch GOTO
6B57get PC of end jump
6B58= dest
6B59level: 0
6B5Bget addr of jump
6B5E+1: point to offset
6B5Fstack level-dest stack level
6B64not zero: remove from stack
6B66patch jump
6B69'
6B6Btrying to jump into a WITH/FOR ?
6B6E71:Invalid GOTO
6B6Fsave PC of end jump
6B70patch jump to current pos
6B73* POP AX
6B76remove another var from stack ?
6B78:no
6B7Arestore PC of end jump
6B7Bemit jump to end jump
6B7Ego to next entry
6B81'next one
6B83restore PC of end jump
6B84point to offset
6B85"patch jump
6B88do block: do statement
6B8BEND ?
6B90yes: done
6B92! ;
6B95'next statement
6B97"
6B98Do statement
6B9Dget compiler directives
6BA0use copy during statement
6BA3user interrupt ?
6BA9:no
6BABset flag: used
6BB0* INT 3
6BB5search keyword - code level
6BBB:found
6BBDsearch var
6BC0:not found
6BC2'do assignment
6BC5search procedure
6BCB:not found
6BCD'do procedure
6BD0search label
6BD6:found
6BD8search function
6BDE:not found
6BE0'do function: assign return var
6BE3search keyword: std procedures
6BE9:found
6BEB'
6BECjump to procedure compilation
6BED"routine
6BEF! : - do label
6BF2lexical level
6BF5= that of label ?
6BF8no:
6BFB72:Label not within current block
6BFClabel already defined ?
6C0043:Duplicate ID or label
6C04store stack level
6C07in label entry
6C0Astore offset
6C10"do statement
6C12IF: evaluate condition
6C15branch opcode
6C18offset
6C1Aemit branch
6C1Dsave pos of jump
6C21emit jump
6C24THEN ?
6C29no:
6C2C17:THEN expected
6C2Ddo statement
6C30ELSE ?
6C35:no
6C37get pos of THEN-jump
6C38save pos of second jump
6C3Cemit second jump
6C3Fpoint to offset
6C40patch jump addr: to ELSE-part
6C43do statement
6C46restore pos
6C47point to offset
6C48"patch jump offset
6C4BWHILE: save loop beg addr
6C4Fevaluate condition
6C52branch opcode
6C55offset
6C57emit branch
6C5Asave pos of jump to end
6C5Eemit it
6C61DO ? Bug: not checked
6C64(try it !!)
6C66do statement
6C69pos of jump
6C6Apos of loop beg
6C6Bemit jump to loop beg
6C6Epoint to offset
6C6F"patch jump to loop end
6C72REPEAT: save loop beg addr
6C76do statement
6C79UNTIL ?
6C7Eyes: end it
6C80! ;
6C83'
6C85evaluate condition
6C88branch opcode
6C8Boffset
6C8Demit branch
6C90restore pos: loop beg
6C91"emit jump to loop beg
6C94FOR
6C97search loop var
6C9Anot found:
6C9D41:Unknown ID or syntax error
6C9Eget var parms
6CA1not indexed
6CA6var indirect ?
6CAByes: error
6CADscalar ?
6CB2:yes, ok
6CB430:Simple type expected
6CB7'
6CB8push var entry
6CBBsave component type
6CBF! :=
6CC2expression -> AX
6CC5* PUSH AX
6CC8component type
6CCA= type read ?
6CCCno:
6CCF44:Type mismatch
6CD0TO or DOWNTO ?
6CD6not found:
6CD918:TO or DOWNTO expected
6CDAstore direction pointer
6CDEexpression -> AX
6CE1test component type
6CE444:Type mismatch
6CE8DO ?
6CEDno:
6CF013:DO expected
6CF1restore entry from stack
6CF4* POP CX
6CF7* XCHG CX,AX
6CFC* SUB CX,AX
6D00get flag: pointer to table entry
6D01get branch
6D03emit it
6D06* branch offset
6D09* JUMP ....
6D0Esave jump pos
6D13emit INC/DEC
6D19store var
6D1Csave PC
6D20* PUSH CX
6D25save var entry
6D28save for-ptr
6D2Cspace used on stack (counter!)
6D30do statement
6D33remove from stack
6D37restore FOR-ptr
6D3Brestore var entry
6D3E* POP CX
6D41(get counter var from stack)
6D48INC/DEC CX
6D4Bemit
6D4Esave PC
6D52emit (dummy) branch to loop end
6D56INC or DEC var ?
6D59word opcode
6D5Btest component size
6D60:word
6D62byte obcode
6D64emit INC loop var
6D67restore PC
6D68restore PC: beg of loop
6D69emit jump to loop beg
6D6CPC-dest-2
6D73-> offset
6D75JZ
6D77patch branch: to loop end
6D7Arestore addr: loop beg-2
6D7D"patch jump to loop end
6D80CASE: get scalar expression
6D83store CASE-type
6D87! OF
6D8Aclear counter: main
6D8Dclear counter: sub
6D8Fsave it
6D90get element / lower bound
6D93.. ?
6D98JZ
6D9A:no
6D9C* JL +05
6DA2get upper bound
6DA5JG
6DA7count: range done
6DA8count space used
6DABrestore counter
6DACcount space used
6DAEcount labels
6DB0save opcode
6DB1save pos
6DB5emit branch op
6DB8, ?
6DBB:no
6DBDbranch distance ok ?
6DC0:yes
6DC2* JMP +02
6DC5make a hip
6DC8clear space used
6DCAget branch pos
6DCBget opcode
6DCCPC-pos-2
6DD3-> offset
6DD5branch opcode
6DD7patch in branch
6DDA:another one
6DDCJMP
6DDEremember opcode
6DDF& position
6DE3emit it (dummy)
6DE6space counter
6DE9'continue
6DEB! :
6DEEemit jump to next case label
6DF1clear space counter
6DF3fill in branches - as above !
6E00patch it
6E03:another
6E05restore main counter
6E06save current pos
6E0Acount case labels
6E0Bsave again
6E0Csave type
6E0F(CASE may be nested !)
6E10do statement
6E13restore type
6E17semicolon ?
6E1Aset flag
6E1C:yes
6E1Eclr flag
6E20save it
6E21END ?
6E26restore flag
6E27:yes
6E29emit jump to end of CASE
6E2Ccounter
6E2Dpos of last comparison
6E2Esave pos of jump to CASE-end
6E32save counter
6E33pos-2
6E35patch jump
6E38flag
6E39ELSE ?
6E3E'flag
6E3F:yes
6E41test flag
6E43:no semicolon
6E45'case loop
6E48flag for semi error
6E4Dcleared:
6E5014:END expected
6E54"41:Unknown ID or syntax error
6E55ELSE-part: do statement
6E58END ?
6E5D:yes
6E5F! ;
6E62'
6E64number of jumps
6E65addr of jump-2
6E67patch jumps to end of CASE
6E6B:another
6E6D"
6E6Eget bound: read num constant
6E71correct type ?
6E7546:Constant and CASE selector type
6E78does not match
6E79* CMP AX,i
6E7Eemit constant: bound
6E7F"
6E82do GOTO
6E85search label
6E88not found:
6E8B40:Undefined label
6E8Clexical level
6E8F= current ?
6E93no:
6E9672:Label not within current block
6E97symtab-ptr of label
6E99store in symtab
6E9Cstore PC
6EA2store stack level
6EA8"emit jump - resolved at block end
6EABWITH: nesting level
6EAEstack level
6EB2save them
6EB3too much ?
6EB8yes:
6EBCget var
6EBFnot found:
6EC241:Unknown ID or syntax error
6EC3type = record ?
6EC8no:
6ECB29:Record variable expected
6ECCindexed ?
6ED1:yes
6ED3segment and offset
6ED7already known
6EDB'store in WITH-buffer
6EDDget var ptr
6EE0* PUSH DI
6EE34 bytes on stack
6EE8get stack level
6EECdummy pos: variable
6EF3nesting level*4 -> BX
6EF5offset into WITH-buffer
6EF9store type, position
6EFC-> WITH-buffer
6F04inc nesting level
6F08, ?
6F0Byes: repeat
6F0DDO ?
6F12no:
6F1513:DO expected
6F16do statement
6F19stack usage
6F1Drestore stack usage, nesting level
6F25remove from stack ?
6F27:nothing to remove
6F29* ADD SP,...
6F2Fvar count * 2
6F33emit byte
6F36"
6F37! ( - Inline
6F3Aflag: byte mode
6F41> ?
6F44:yes
6F46word mode
6F4B< ?
6F50:yes
6F52normal mode
6F57clear number
6F59clear neg flag
6F5Bsave
6F5Dread num constant
6F60:no good
6F62type = integer ?
6F65no:
6F6822:Integer constant expected
6F69result -> AX
6F6A'
6F6Cnormal mode ?
6F71:no
6F73set word mode
6F78* ?
6F7D:no
6F7FPC -> result
6F82'
6F84search var
6F8A:not found
6F8Cget var parms
6F8Fget var offset
6F92'
6F94search proc
6F9A:found
6F9Csearch func
6FA2not found:
6FA574:Inline error
6FA6get offset
6FA9restore
6FAB:no negation
6FADnegate result
6FAFadd to number
6FB1clear neg flag
6FB3+ ?
6FB8:yes
6FBAset neg flag
6FBB- ?
6FC0:yes
6FC2else: end of expression
6FC3byte mode ?
6FC8:word mode
6FCA:byte mode
6FCCnormal mode: result > 255 ?
6FCE:yes
6FD0emit byte
6FD3'
6FD5emit word
6FD8/ ?
6FDDno: end it
6FDF'loop back: next expression
6FE2! )
6FE5"
6FE6procedure call: stack checking
6FE9save symtab pos
6FEAparameter count
6FEDgo to parameter
6FF0any parms ?
6FF2:yes
6FF4'none - end it
6FF7! (
6FFAparameter loop
6FFBsave counter, symtab pos
6FFCparm count same type
6FFFtype ptr
7002get type parms
7005save counter
7006VAR-parameter ?
7008:yes
700Aset ?
700F:below, complex var
7011get expression -> AX/stack
7014type checking, conversions
7017range check
701Ascalar ?
701F:yes
7021ptr ?
7026:no
7028* PUSH DX
702D* PUSH AX
7030'next parm
7032string ?
7037:no
7039get max length
7041* MOV CL,max_len
7044adapt string size
7047* CALL xstrparm
704A'next parm
704Cset ?
7051no:next parm
7053calc set crunch factor
7056adapt set size
7059* CALL xsetparm
705C'next parm
705Esave var entry: complex var
7061do full var
7064no good:
706741:Unknown ID or syntax error
7068get var ptr
706Bcomponent size
706E* MOV CX,compo_size
7071copy complex var to stack
7074* CALL xblkparm
7077'check type
7079save entry - VAR-parameter
707Cget var ptr
707F* PUSH DI
7082copy entry from stack
7085type = 0 ?
708Ayes: untyped
708Ctype checking struct vars
708Frestore entry
7092restore counter
7093another parm of same type ?
7095:no
7097! ,
709A'loop back - same type
709Drestore symtab pos
709Ego to next parm
70A1get cnt
70A5skip var entries
70AAskip name
70ACcount down
70AE:another
70B0restore count
70B1another parameter ?
70B3:no
70B5! ,
70B8'loop back
70BB! )
70BEsymtab pos
70BFoverlay ?
70C4:no
70C6* MOV AX,proc_len
70C9get file offset
70CC* MOV DX,file_offs
70CFget proc offset
70D2"* CALL proc
70D5Stack checking ?
70DB:switched off
70DDget space needed
70E0* MOV CX,space_needed
70E6* CALL xchkstk
70E9"
70EADo assignment: untyped ?
70EFyes: error
70F1file var ?
70F6:no
70FD:no
70FFfiles cannot be assigned !
7102'54:Illegal assignment
7103scalar ?
7108:yes
710Apointer ?
710F:no
7111segment = ES ?
7116:no
7118set flag: PUSH ES
711Dindexed ?
7122:no
7124set flag: PUSH DI
7129'
712Bget var ptr
712E* PUSH DI
7131! :=
7134set ?
7139:no, complex type
713Bsave dest var entry
713Esave PC
7142evaluate expression
7145old = new PC ?
714Aclear flag: PUSH ES
7150save difference
7151get expression, ready for store
7155restore dest var entry
7158save diff
7159type checking, conversions
715Dscalar ?
7162:yes
7164pointer ?
7169:no
716Btest diff
716Dnone: ok
716Findexed ?
7174:no
7176* POP DI - restore ptr
717Bsegment = ES ?
7180:no
7182* POP ES
7187'Store var
718Astore dest var entry
718Ddo full var
7190no good:
719341:Unknown ID or syntax error
7194get var ptr
7197restore dest var entry
719Atype checking - struct vars
719Dcomponent size
71A0* MOV CX,comp_size
71A6'* CALL xmovevar
71A9Type checking, conversions
71AE:no real
71B0now integer ?
71B3:no
71B5conversion int -> real
71B8* CALL xintreal
71BBnow real
71BD'
71BFstring expected ?
71C4:no
71C6result = char ?
71C9:no
71CB* MOV AH,AL
71CE* MOV AL,01
71D4* PUSH AX
71D6'now string
71D8char expected ?
71DD:no
71DFresult = string ?
71E2:no
71E4convert to char
71E7* CALL xstrch
71EAnow char
71ECtype = expected ?
71F0no: error
71F2set ?
71F5:no
71F7constant ?
71F9yes: ret
71FBsame base type ?
7202yes: ret
720444:Type mismatch
7207'
7208pointer ?
720Bno: ret
720Dtype pointer
7210untyped ?
7212yes: ret
7214compare types
7218different: error
721A"
721BType checking struct vars
721Etype expected: untyped ?
7220yes: type mismatch
7222check everything
7224scalar ?
7226yes: check it
7228string ?
722A:no
722Ccheck type only
722Estring checking ?
7234:no
7236check type, component size
7238text, untyped file ?
723A:check it
723Eset ?
7240:check it
7242check type, rec nest, size
7244record ?
7246:check it
7248second type
724Dcheck everything
724F:check it
7251second type
7255scalar index ?
7259no: type mismatch
725Bcheck type, lower, upper, size
725Dcheck buffers
7263check 8 bytes
7266test this byte ?
7268:no
726Acompare
726Edifferent: error
7270next byte
7272:another
7274'
727544:Type mismatch
7278"
7279get var parms
727Cindirect ?
7281yes:
728441:Unknown ID or syntax error
7285do indexing
7288"do assignment
728BASSIGN: get file var
728Enormal Assign
7291text file ?
7294:no
7296assign text file
7299get params
729C'do checking
729Esave call addr
729F* PUSH DI
72A2! ,
72A5get string expr
72A8restore call addr
72A9save call addr
72AA! )
72ADcall addr
72AE"emit call
72B1RENAME: get file var
72B7get string, emit call
72BA"do checking
72BCERASE: get file var
72C2'put it
72C4CHAIN
72C7'put it
72C9EXECUTE
72CCsave addr
72CDget file var
72D0restore addr
72D1test ), emit call
72D4"do checking
72D7SEEK, LONGSEEK: get file var
72DAtext file ?
72DDyes:
72E063:Textfiles are not allowed here
72E1* PUSH DI
72E4! ,
72E7get num expr
72EDinteger ?
72F0:yes
72F2real...
72F5"test ), emit call, check
72F7APPEND: get file var
72FAtext file ?
72FDno:
730035:Textfile expected
7301component size
7304sub size of file var
7307* MOV CX,buf_size
730D"test ), emit call, check
730FRESET
7312'ptr into vector table
7314REWRITE
7317save ptr
7318get file var
731Btyped file ?
7320:no
7322type ptr
7326get var parms
7329component size
732C* MOV CX,compo_size
732F'
7331text file ?
7336:no
7338var size-base size
733E* MOV CX,buf_size
7341'
7343* PUSH DI - untyped file
7346, ?
7349:no
734Bsave var entry
734Eget int expr: block size
7351restore var entry
7354'
7356std blk size
7359* MOV AX,0080
735Crestore table index
735D'
735FTRUNCATE
7362'
7364FLUSH
7367'
7369CLOSE
736Csave table index
736Dget file var
7370restore index
7371! )
7374emit call
7377"do checking
737Aemit call for I/O
737D(component type-5)*2
7383+ BX -> pointer
7386get vector
7388"emit call
738Bvector table for I/O
73A3"
73A9! (
73ACget file var
73AFok:ret
73B4'21:File variable expected
73B5"
73B6get file var: get var
73B9:found
73BBnot found
73BC'
73BDfile var ?
73C2:no
73C9:no
73CBget var ptr
73CEget type
73D2ok
73D5"
73D6READLN: set flag
73D8'
73DAREAD
73DCstore flag
73DF( ?
73E2:yes
73E4set input path
73E7'do checking
73EAget file var
73ED:error
73EFno file var: use std
73F1typed file ?
73F4:no
73F6'do read typed file
73F9text file ?
73FCno:
73FF65:Untyped files are not allowed here
7400(prepare for input)
7403* CALL xrdfil
7406'
740941:Unknown ID or syntax error
740C'
740Dset input path
7410'
7412parameter loop: read var
7415not found:
741841:Unknown ID or syntax error
7419get var ptr
741Ccomponent type
7420array ?
7423yes: read as byte block
7425file, ptr, set, record ?
7428:not allowed
742Aboolean ?
742D:not allowed
742Fscalar ?
7432below: ok
743466:I/O not allowed here
7437'
7438type ptr - test array of char
743Ccomponent type = char ?
7440no:error
7442index type = integer ?
744Ano:error
744Ccomponent size
744F> 255 ?
7451yes:error
7453* MOV CL,len
745A(read array of char)
745D'
745Fstring ?
7462:no
7464max len-1
746C* MOV CL,max_len
746F(read string)
7472'
7474(read real)
7477real ?
747A:yes
747C(read char)
747Fchar ?
7482:yes
7484(read integer)
7487word ?
748C:yes
748E(read byte)
7491emit call
7494another var ?
7497no: end it
7499'parameter loop
749C! )
749F(readln)
74A2ReadLn ?
74A7:no
74A9emit call
74ACdo I/O-checking ?
74B2:no
74B4(I/O-check)
74BA"
74BBset input path: std input
74BEbuffer > 0 ?
74C3yes: do it
74C5test I/O-mode
74CB:MS-DOS std input
74CD(read with editing)
74D0ReadLn ?
74D5:no
74D7clear flag
74DC(Readln with editing)
74DF"emit call
74E2WRITELN
74E4'
74E6WRITE
74E8set flag
74EB( ?
74EEyes: ok
74F0set std output
74F3emit call
74F6'end it
74F9get file var
74FC:none
74FEno file var
7500typed file ?
7503:no
7505'write typed file
7508text file ?
750Bno:
750E65:Untyped files are not allowed here
750F(prepare for write)
7512* CALL xwrfil
7515'
7518set std output
751B* CALL xstdout
751Eexpression (var pre-read)
7521'check type
7523set std output
7526* CALL xstdout
7529get const element
752C:no, try expression
752Estring ?
7531:no
7533check current char
7537, ?
753A:yes
753C) ?
753Fno: normal
7541(write inline string)
7544* CALL xwrtinl
7547emit string
754A'get next element
754Dexpression (const pre-read)
7550'check type
7552expression (var pre-read)
7555string ?
7558below:illegal
755Ascalar ?
755Dbelow: ok
755F66:I/O not allowed here
7562'
7563integer ?
7566below: real, string
7568* PUSH AX - stack it
756B: ?
756Eno:default format
7570save type
7571get int expression
7575real ?
7578no: no second parm
757A: ?
757Dno: use default
757F* PUSH AX
7582save type
7583get int expression
7587'continue
7589standard format
758Breal ?
758E:no
7590default: 18 chars
7592* MOV AX,field_len
7595real ?
7598:no
759A* PUSH AX
75A0* MOV AX,#FFFF
75A3(write string)
75A6string ?
75A9:yes
75AB(write real)
75AEreal ?
75B1:yes
75B3(write integer)
75B6integer ?
75B9:yes
75BB(write boolean)
75BEboolean ?
75C1:yes
75C3(write char)
75C6emit call
75C9, ?
75CCno: end it
75CE'do param loop
75D1! )
75D4(writeln)
75D7"like read/readln
75DARead typed file
75DD'(read byte block)
75DFWrite typed file
75E2ReadLn/WriteLn ?
75E7yes:
75EA35:Textfile expected
75EBsave addr
75EC(select file)
75EF* CALL xfilsel
75F2type ptr
75F6get type parms
75F9, ?
75FCno: end it
75FEpush entry
7601get var ptr
7604pop entry
7607check type struct vars
760Aget routine addr
760C* CALL xwrvar / xrdvar
760F'parameter loop
7611remove
7612! )
7615"do checking
7618BLOCKREAD
761Bwith / without res var
761E'
7620BLOCKWRITE
7626save addr
7628get file var
762Buntyped ?
762Eno:
763137:Untyped file expected
7632* PUSH DI
7635! ,
7638get var ptr (src/dst var)
763B* PUSH DI
763E! ,
7641get int expr (count)
7644, ?
7647restore addr
7649yes: with result var
764Bwithout result var
764C'
764Esave routine addr
764F* PUSH AX (save count)
7652get res var ptr
7655integer ?
765Ano: error
765Cword ?
7661yes: ok
766324:Integer variable expected
7666'
7667"emit call, check end
766ACHDIR
766D'
766FMKDIR
7672'
7674RMDIR
7677save addr
7678! (
767Bget string expr
767E"complete it
7681! ( : GETDIR
7684get int expr
7687* PUSH AX
768A! ,
768Dget string var
7690max len-1
7698* MOV CL,max_len
769E"end it
76A1! ( : OVRPATH
76A4get string expr
76AA"end it
76AD! ( : DELETE
76B0get string var
76B3* PUSH DI
76B6! ,
76B9get int expr
76BC* PUSH AX
76BF! ,
76C2get int expr
76C8"end it
76CB! ( : INSERT
76CEget string expr
76D1! ,
76D4get string var
76D7* PUSH DI
76DAcomponent size - 1
76E2save it
76E3! ,
76E6get integer expr
76E9restore
76EA* MOV CL,max_len
76F0"end it
76F3get string var: get var ptr
76F6string ?
76FBno:
76FE34:String variable expected
76FF"
7700! ( : STR
7703get num expr
7706integer ?
7709real: is already on stack !
770B* PUSH AX
770E: ?
7711:no formatting
7713save type
7714get int expr
7717* PUSH AX
771Arestore type
771Binteger ?
771Eyes: no second parm
7720: ?
7723no: get default
7725save type
7726get int expr
7729* PUSH AX
772Crestore type
772D'
772Fset default
7731integer ?
7734:yes
7736real: 18 chars
7738* MOV AX,i
773B* PUSH AX
773Einteger ?
7741:yes
7743default for second parm:
7746* MOV AX,#FFFF
7749* PUSH AX
774C! ,
774Fsave type
7750get string var
7753component size-1
775B* MOV CL,max_len
775Erestore type
775F(str integer)
7762integer ?
7765:yes
7767(str real)
776A"emit call, check )
776D! ( : VAL
7770get string expression
7773! ,
7776get dest var ptr
7779test type
777Dinteger ?
7780:yes
7782real
7785:yes
778727:Integer or real var expected
778A'
778Btest component size
7790byte: error
7792save type
7793* PUSH DI
7796! ,
7799get status var ptr
779Cinteger ?
77A1no: error
77A3byte ?
77A8word:ok
77AA24:Int var expected
77AD'
77AErestore type
77AF(val integer)
77B2integer ?
77B5:yes
77B7(val real)
77BA"emit call, check )
77BC! ( : GOTOXY
77BFget integer expr
77C2* PUSH AX
77C8save addr
77C9! ,
77CCget integer expr
77CFrestore addr
77D0"emit call, check )
77D3RANDOMIZE
77D6"emit call
77D9NEW
77DCsave addr
77DD! (
77E0get var ptr
77E3pointer var ?
77E8no: error
77EAget type ptr
77EEget type parms
77F1get its component size
77F4* MOV CX,compo_size
77F7restore addr
77F8"emit call, check )
77FBGETMEM
77FEsave addr
77FF! (
7802get var ptr
7805pointer ?
780Ano: error
780C* PUSH DI
780F! ,
7812get int expr
7815restore addr
7816"emit call, check )
7819DISPOSE
781C"like New
781EFREEMEM
7821"like Getmem
7823MARK
7826'like Release
7828RELEASE
782Bsave addr
782C! (
782Fget var ptr
7832restore addr
7833pointer ?
7838no: error
783A'emit call, check )
783D28:Pointer var expected
7840"
7841! ( : MOVE
7844get src var ptr
7847* PUSH DI
784A! ,
784Dget dest var ptr
7850* PUSH DI
7856"get int expr, end it
7859! ( : FILLCHAR
785Cget dest var ptr
785F* PUSH DI
7862! ,
7865get int expr
7868* PUSH AX
786B! ,
786Eget scalar expr
7874"end it
7877EXIT: clear flag
7879"do it
787CHALT: ( ?
787Fno: normal
7881get int expr
7884! )
7887'
7889* XOR AX,AX
7892"emit jump
7895! ( : MSDOS
7898int number 21
789Bsave it
789C'like INTR
789E! ( : INTR
78A1read integer constant
78A4save it
78A5! ,
78A8get var ptr
78AB(set registers from rec)
78AE* CALL xsetregs
78B1interrupt number
78B4* INT nn
78B9(get registers back)
78BC"emit call, check )
78BFPORTW: opcode OUT
78C1'
78C3PORT: opcode OUTB
78C5save opcode
78C6! [
78C9get int expr
78CC! ]
78CF* PUSH AX (port number)
78D2! :=
78D5get int expr
78D8* POP DX
78DDrestore opcode
78DE"emit OUT [DX],AX
78E1CRTINIT
78E4'
78E6CRTEXIT
78E9'
78EBCLRSCR
78EE'
78F0CLREOL
78F3'
78F5NORMVIDEO, HIGHVIDEO
78F8'
78FALOWVIDEO
78FD'
78FFINSLINE
7902'
7904DELLINE
7907"emit call
790ADELAY
790Dsave addr
790E! (
7911get int expr
7914restore addr
7915"emit, check )
7918WINDOW
791Bsave addr
791C! (
791Fget int expr
7922* PUSH AX
7925! ,
7928get int expr
792B* PUSH AX
792E! ,
7931get int expr
7934* PUSH AX
7937restore addr
7938"get int, end it
793BTEXTCOLOR
793E"(int)
7940TEXTBACKGROUND
7943"(int)
7945GRAPHBACKGROUND
7948"(int)
794APALETTE
794D"(int)
794FHIRESCOLOR
7952"(int)
7954GRAPHCOLORMODE
7957'emit call
795AGRAPHMODE
795D'emit call
795FHIRES
7962"emit call
7964TEXTMODE
7967( ? yes: get mode
796C* MOV AX,#00FF
796F'
7971get int expr
7974! )
797A"emit call
797DGRAPHWINDOW
7980"like window
7982! ( : PLOT
7988save it
7989"like window - only 3 parms
798B! ( : DRAW
798Eget int expr
7991* PUSH AX
7994! ,
799Asave addr
799B"now like window
799DSOUND
79A0"(int)
79A3NOSOUND
79A6"emit call
79A9push entry
79ACread expression
79AFrestore entry
79B2"
79B3get integer expression: rd expr
79B6integer ?
79B9yes:ret
79BB23:Integer expression expected
79BE"
79BFget numeric expression: rd expr
79C2integer ?
79C5yes: ret
79C7real ?
79CAyes: ret
79CC26:Int or real expression expected
79CF"
79D0get scalar expression: rd expr
79D3scalar ?
79D6:ok
79D8string ?
79DBno:
79DE31:Simple expression expected
79DF(string -> char)
79E2* CALL xstrch
79E5type: char in AX
79E8"
79E9get string expression: do expr
79ECstring ?
79EF:yes
79F1char ?
79F4no:
79F733:String expression expected
79F8constant ?
79FA:no
79FCget result
79FFchar
7A01length
7A03* MOV AX,#...
7A06'
7A08get atom
7A0B* MOV AH,AL
7A0E* MOV AL,#01
7A13* PUSH AX
7A16type = string
7A18"
7A19evaluate boolean expr: do expr
7A1Cboolean ?
7A1Fno:
7A2220:Boolean expression expected
7A23get atom
7A26comparision outside ?
7A29yes: ok
7A2Bstore branch op: JNZ
7A30flags set ?
7A33:yes
7A35* OR AX,AX
7A3B"
7A3Cread expression
7A3Fscalar ?
7A42below: ret
7A44get atom
7A47"flags -> boolean
7A4Ado expression - var pre-read
7A4Dset up return stack
7A5A"start with var
7A5Ddo expression - const pre-read
7A60set up return stack
7A6D"start with const
7A70Comparison level: do add level
7A73save type
7A74check comparisons
7A7Arestore type
7A7Bfound: do comparison
7A7D'
7A7EIN ?
7A80:yes
7A82save op ptr, type
7A84save entry
7A87save PC
7A8Bsave type ptr
7A8Faddition level
7A92restore type ptr
7A96restore PC
7A9Arestore type
7A9Bdo type conversion
7A9Erestore op ptr
7A9Fscalar ?
7AA2:no
7AA5set branch opcode
7AA8(from comparison table)
7AABemit parms for comparison
7AAEemit instruction
7AB1return type: boolean, flags set
7AB4'
7AB5real, string, set, ptr comparisons
7AB6get offset in cmp table
7AB8-> table index
7ABAreal ?
7ABD:yes
7ABF+2
7AC1string ?
7AC4:yes
7AC6+2
7AC8set ?
7ACB:yes
7ACD+2;(pointer)
7AD0get vector from table
7AD4test it
7AD647:Operand type(s) do
7AD9not match operator
7ADA'end it
7ADCIN: get atom
7ADF* PUSH AX
7AE2save type
7AE3do addition level
7AE6restore type
7AE7set ?
7AEA47:Operand type(s) do
7AEDnot match operator
7AEEconstant ?
7AF0:yes
7AF2compare types
7AF4different base type:
7AF744:Type mismatch
7AFB* CALL xsetin
7AFEboolean, flags set
7B01"
7B02= vector table for comparisons
7B0A<>
7B12>=
7B1A<=
7B22>
7B2A<
7B2E"
7B32Addition level: do mult level
7B35save type
7B36check add ops
7B3Crestore type
7B3D:found
7B3F'
7B40pointer ?
7B43yes:
7B4647:Operand type(s) does not match op
7B47save op ptr
7B48save type
7B49save first result
7B4Csave PC
7B50mult level
7B53char ?
7B56:no
7B58constant ?
7B5A:no
7B5Cget resulting char
7B61convert to string
7B63* MOV AX,#..
7B66'
7B68load second result
7B6B* MOV AH,AL
7B6E* MOV AL,#01
7B73* PUSH AX
7B76convert to string
7B78restore PC
7B7Ctype first part
7B7Ddo type conversions
7B80restore op ptr
7B82OR, XOR ?
7B85:yes
7B87(set +)
7B8A(set -)
7B8Dset ?
7B90:yes
7B92(add real)
7B95(sub real)
7B98real ?
7B9B:no
7B9Eadd ?
7BA1:yes
7BA3get subtract vector
7BA4emit call
7BA7'loop back
7BA9string ?
7BAC:no
7BAFadd ?
7BB2no:
7BB547:Operand type(s) does not match op
7BB6(concat strings)
7BB9'emit call, loop back
7BBBboolean ?
7BBE:yes
7BC0scalar ?
7BC3no:
7BC647:Operand type(s) does not match op
7BC7emit instructions
7BCA"loop back
7BCDMultiplication level: do unary level
7BD0save result type
7BD1check multiplication ops
7BD7restore type
7BD8:found
7BDA'
7BDBpointer ?
7BDEyes:
7BE147:Operand type(s) does not match op
7BE2save op ptr, type
7BE4emit push first value
7BEBdo unary level
7BEErestore old PC
7BF2type first op
7BF3op ptr
7BF4save it again
7BF6division ?
7BF9:no
7BFBsecond = integer ?
7BFE:no
7C00load result
7C03convert to real
7C06* CALL xintreal
7C09now real
7C0Bdo type conversions
7C0Eop ptr
7C10division ?
7C13higher: no reals, sets
7C15:division
7C17(multiply real)
7C1Areal ?
7C1D:yes
7C1F(set *)
7C22set ?
7C25no: go out
7C27emit call
7C2A'loop back
7C2C(divide real)
7C2Freal ?
7C32:yes
7C3447:Operand type(s) does not match op
7C37'
7C38AND ?
7C3C:no
7C3Eboolean ?
7C41:yes
7C43scalar ?
7C46no:
7C4947:Operand type(s) does not match op
7C4Aemit arithmetic op
7C4D"loop back
7C4FUnary level
7C52NOT ?
7C54:no
7C56do negation level
7C59flags -> boolean
7C5Cinteger ?
7C5F:ok
7C61boolean ?
7C64no:
7C6747:Operand type(s) does not match op
7C68load value
7C6B* XOR AL,#01
7C71flags set...
7C73'
7C74get value
7C77* NOT AX
7C7D'
7C7Edo negation: save flag
7C82test sign
7C85store it
7C89do atom
7C8Cget neg flag
7C90test type
7C93:ok
7C95integer ?
7C98:no
7C9Aget value
7C9D* NEG AX
7CA3'
7CA5(negate real)
7CABrestore neg flag
7CAF"
7CB0store result on stack
7CB3integer ?
7CB6:no
7CB8get value
7CBBset flag: PUSH AX
7CC0'
7CC1pointer ?
7CC4:no
7CC6* PUSH DX
7CC9* PUSH AX
7CCC"
7CCDDo type conversions
7CD0no PUSH AX
7CD5first = real ?
7CD8:no
7CDAsecond = integer ?
7CDD:no
7CDFget value
7CE5* CALL xintreal
7CE8-> real
7CEA'
7CECfirst = string ?
7CEF:no
7CF1second = char ?
7CF4:no
7CF6constant ?
7CF8:no
7CFAget char
7CFDconvert to string
7D01* MOV AX,#i
7D04'
7D06get value
7D09* MOV AH,AL (convert to string)
7D0C* MOV AL,#01
7D11* PUSH AX
7D14-> string
7D16second = real ?
7D19:no
7D1Bfirst = integer ?
7D1E:no
7D20convert first number
7D26first -> real
7D28'
7D2Asecond = string ?
7D2D:no
7D2Ffirst = char ?
7D32:no
7D34first -> string
7D37* CALL xchstr1
7D3A-> string
7D3Csecond = integer ?
7D3F:no
7D41calculated ?
7D44:no
7D46* POP CX
7D4B'
7D4DPC = old PC ?
7D54:yes
7D56* POP AX
7D59'
7D5Bpointer ?
7D5E:no
7D60* POP BX
7D63* POP DX
7D66first = second ?
7D68no:
7D6B44:Type mismatch
7D6Cset ?
7D6F:no
7D71same base types !
7D73:ok
7D75constant 1 ?
7D77yes: ret
7D79constant 2 ?
7D7Bcopy base type
7D7Dyes: ret
7D7F44:Type mismatch
7D82'
7D83pointer ?
7D86:no
7D88untyped ?
7D8Dyes: ret
7D8Funtyped ?
7D94yes: ret
7D96get type ptr
7D99compare
7D9Dequal: ok
7D9F44:Type mismatch
7DA2'
7DA3"
7DA4load value -> AX
7DA6:no constant
7DA8get result
7DAB* MOV AX,#result
7DAE'
7DB0var ?
7DB3no: ret - already in AX
7DB5save
7DB7load var
7DBCflag: in AX
7DBE"
7DBFFlags -> boolean
7DC2:no boolean
7DC4flags set ?
7DC7:constant, var, AX
7DC9flags set: ok
7DCBconvert
7DCE* MOV AX,#0001
7DD5emit branch op
7DD8* offset
7DDB* DEC AX
7DDEflag: result in AX
7DE0"
7DE1Emit arithmetic operation
7DE2second = const ?
7DE4:no
7DE7is there a const form ?
7DEB:no
7DEEget its opcode
7DF1emit it
7DF4emit the result
7DF7as immediate value
7DFA'done
7DFCtake immediate
7DFF* MOV CX,#result
7E02'
7E04variable ?
7E07:no
7E0Ais there a var form ?
7E0E:no
7E11CWD needed ?
7E15:no
7E1A* CWD
7E1Dbase opcode
7E20convert to AX,var
7E23emit instruction
7E26'done
7E28* MOV CX,...
7E2Bemit instruction
7E2E'
7E30second number in AX
7E31XCHG needed ?
7E35:no
7E3A* XCHG CX,AX
7E3DCWD needed ?
7E41:no
7E46* CWD
7E49base opcode
7E4Cemit it
7E50second XCHG needed ?
7E54:no
7E59* XCHG DX,AX (for MOD)
7E5Brestore type
7E5Cresult in AX
7E5E"
7E5FDo atom: do var
7E62:done
7E64do constant
7E67:done
7E69do function
7E6C:done
7E6Edo set
7E71:done
7E73do parentheses
7E76:done
7E78do standard functions
7E7B:done
7E7Ddo type conversions
7E80:done
7E82test for NIL
7E85not found:
7E8841:Unknown ID or syntax error
7E89"
7E8Aget var
7E8Dno:ret
7E8Fcomponent type:
7E92integer ?
7E94:below
7E96var
7E98byte ?
7E9D:no, word
7E9Fload var
7EA2now in AX
7EA4get component type
7EA8'ok
7EAAreal ?
7EAC:yes
7EAEstring ?
7EB0:yes
7EB2set ?
7EB4:yes
7EB6pointer ?
7EB8:no
7EBAload var
7EBDtype ptr
7EC5component type
7EC9set ?
7ECC:no, ok
7ECEget base type
7ED1'ok
7ED3array ?
7ED5no:
7ED862:Struct vars are not allowed here
7ED9get var ptr
7EDCtype ptr
7EE0array of char ?
7EE4no:
7EE762:Struct vars are not allowed here
7EE8index type
7EEC= scalar ?
7EF0no:
7EF362:Struct vars are not allowed here
7EF4component size
7EF7> 255 ?
7EF9yes:
7EFC62:Struct vars are not allowed here
7F01* MOV CL,#len
7F04(load array of char)
7F07* CALL xldarrch
7F0Cok
7F0E"
7F0Fget constant element
7F12no good: ret
7F14negation flag
7F18do negation
7F1Bclear neg flag
7F21real ?
7F24:no
7F26(load real constant)
7F29* CALL xrealcn
7F2Cemit real constant
7F2Fas inline code
7F3E'ok
7F40string ?
7F43:no
7F45(get inline string)
7F48* CALL xstrcn
7F4Bsave
7F4Cemit string
7F50'ok
7F52store result
7F56type: constant
7F58ok
7F5A"
7F5BDo function
7F5Esearch it
7F61not found: ret
7F63emit stack check
7F66result type ptr
7F6Aresult type size
7F6Dallot stack space for result
7F70call function (like procedure)
7F73get var parms
7F76result type ptr
7F7Ccomponent type
7F80result in AX / on stack
7F82boolean ?
7F85:no
7F87flags set
7F89ok
7F8B"
7F8CAllocate space on stack
7F8F:offset > 2
7F91offset -> CX
7F92:nothing to allot
7F94* DEC SP
7F99:another byte
7F9B'
7F9Cshort or long offset
7F9Fshort
7FA2:short
7FA4long
7FA6save AX
7FA7* SUB SP,#....
7FAArestore
7FABshort ?
7FAE:no
7FB0'emit byte offset
7FB3"emit word offset
7FB6Do set: [ ?
7FB9no:ret
7FBB(make empty set)
7FBE* CALL sldempty
7FC1] ?
7FC4type: untyped set
7FC7:yes
7FC9save type
7FCAget scalar expression
7FCDtype read
7FCFrestore type
7FD0typed set ?
7FD2:yes
7FD4set type from const read
7FD6compare base type
7FD8not equal:
7FDB44:Type mismatch
7FDCsave type
7FDD.. ?
7FE2(include element in set)
7FE5:no
7FE7* PUSH AX
7FEAget scalar expr
7FEDresult type
7FF1= type of set ?
7FF3no:
7FF644:Type mismatch
7FF7(include range in set)
7FFAemit call
7FFDrestore type
7FFE, ?
8001yes: loop back
8003! ]
8006ok
8008"
8009Do parentheses: ( ?
800Cno:ret
800Eget expression
8011! )
8014ok
8016"
8017Do type conversions
801Asearch type
801Dnot found: ret
801Fget type ptr
8022get component type
8025scalar ?
8027no:
802A30:Simple type expected
802Bsave type
802C! (
802Fget expression
8032! )
8035check simple type
8038restore type
8039convert to type wanted
803Bok
803D"
803Etest for NIL
8043no:ret
8045* XOR AX,AX
8048* XOR DX,DX
804Dtype: pointer
804Fok
8051untyped ptr
8054"
8055Do standard functions
805Bnot found: ret
805Ecall compiler routine
8060flag: result in AX
8062boolean ?
8065:no
8067flags set
8069ok
806B"
806CSQR (num)
806Finteger ?
8072:no
8077* IMUL AX
807A'
807B(sqr real)
807E"emit call
8081ABS (num)
8084(abs integer)
8087integer ?
808Ayes: emit call
808C(abs real)
808F"
8091SQRT
8094'
8096SIN
8099'
809BCOS
809E'
80A0ARCTAN
80A3'
80A5LN
80A8'
80AAEXP
80AD'
80AFINT
80B2'
80B4FRAC
80B7save function addr
80B8(num)
80BBreal ?
80BE:yes
80C0(integer -> real)
80C6now: real
80C8restore addr
80C9"emit call
80CCTRUNC
80CF'
80D1ROUND
80D4save addr
80D5(num)
80D8restore
80D9integer ?
80DC:no
80DE'int: do nothing
80DFconvert to integer
80E1"emit call
80E4SUCC: INC AX
80E6'
80E8PRED: DEC AX
80EAsave opcode
80EB(scal)
80EErestore op
80EF"emit it
80F2LO: (int)
80F8* XOR AH,AH
80FB"
80FCHI: (int)
80FF* MOV AL,AH
8102* XOR AH,AH
8107"
8108SWAP: (int)
810E* XCHG AH,AL
8111"
8112ODD: (int)
8118* AND AX,#0001
811Cboolean result
811E"
811FKEYPRESSED
8122result: boolean
8124"emit call
8127ORD: (scalar)
812Aresult: integer
812C"
812DCHR: (int)
8130result: char
8132"
8133! ( : LENGTH
8139save addr
813Aget string expression
813D! )
8140restore addr
8141"int result, emit call
8143! ( : POS
8146get string expression
8149! ,
814F"get second string expr
8151! ( : COPY
8154get string expr
8157! ,
815Aget int expr
815D! ,
8160* PUSH AX
8163get int expr
8169emit call
816C! )
816Fresult: string
8171"
8172! ( : CONCAT
8175get string expr
8178, ?
817Bno:end it
817Dget string expr
8183emit call
8186"another string ?
8188PARAMCOUNT
818B"result: integer
818EPARAMSTR: (int)
8194result: string
8196"emit call
8199RANDOM: ( ?
819C(random real)
819Fresult: real
81A1no (: take real
81A3get int expr
81A6! )
81A9(random int)
81ACresult: integer
81AE"emit call
81B1IORESULT
81B4"-> integer
81B6EOF: (file)
81B9ptr to vector table
81BCemit call for I/O
81BFresult: boolean
81C1"
81C2SEEKEOF
81C5'
81C7SEEKEOLN
81CA'
81CCEOLN
81CFsave addr
81D0(file)
81D3text file ?
81D6no:
81D935:Textfile expected
81DArestore addr
81DBemit call
81DE"result: boolean
81E0FILEPOS
81E3'
81E5FILESIZE
81E8save addr
81E9(file)
81ECaddr
81EDtext file ?
81F0yes:
81F363:Textfiles are not allowed here
81F4"int result, emit call
81F6LONGFILEPOS
81F9'
81FBLONGFILESIZE
81FEsave addr
81FF(file)
8202addr
8203text file ?
8206yes:
820963:Textfiles are not allowed here
820Aresult: real
820C"emit call
820FMEMAVAIL
8212"int result, emit call
8214MAXAVAIL
8217"int result, emit call
8219! ( : ADDR
821Cget var ptr
821F* POP DX
8222* XCHG DI,AX
8225! )
8228result: pointer
822Auntyped
8230"
8231! ( : PTR
8234get int expr
8237! ,
823A* PUSH AX
823Dget int expr
8240* POP DX (segment)
8245"expect ), pointer
8247! ( : OFS
824Asearch procedure
8250:found
8252search function
8258:not found
825Aget offset
825D* MOV AX,#proc_offset
8260'type: integer
8262get var
8265not found:
826841:Unknown ID or syntax error
8269get offset
826C* XCHG DI,AX
826F(offset -> AX)
8271! )
8274result: integer
8276"
8277! ( : SEG
827Aget var
827Dnot found:
828041:Unknown ID or syntax error
8281(MOV AX,DS)
8285DS ?
828Ayes: ok
828C(MOV AX,ES)
828EES ?
8293yes: ok
8295(MOV AX,SS)
8297below: ok
8299(MOV AX,CS)
829Bemit word
829E"expect ), integer
82A0! ( : SIZEOF
82A3search type
82A9:not found
82ABtype ptr
82AEget component size
82B1* MOV AX,#compo_size
82B4'(Bug: redundant load !)
82B6get var
82B9not found:
82BC41:Unknown ID or syntax error
82BDget component size
82C0"emit MOV AX,#.., integer
82C2DSEG
82C5* MOV AX,DS
82C8'int result
82CACSEG
82CD* MOV AX,CS
82D0'int result
82D2SSEG
82D5* MOV AX,SS
82D8integer
82DA"
82DBPORTW
82DD'(IN AX,[DX])
82DFPORT (INB AL,[DX])
82E1save opcode
82E2! [
82E5get int expr
82E8! ]
82EE* XCHG DX,AX (port number)
82F0restore opcode
82F1emit it
82F4integer ?
82F6:yes
82F8byte:
82FB* XOR AH,AH
82FE"int result
8300UPCASE: (scalar)
8303result: char
8308"emit call
830BWHEREX
830E"int result, emit call
8311WHEREY
8314"int result, emit call
8317"EOF vector table
831D! ( : get (int)
8320get int expr
8323"! )
8326! ( : get (num)
8329get num expr
832C"! )
832F! ( : get (scalar)
8332get scalar expr
8335"! )
8338get (file): ( ?
833B:no
833Dget file var
8340:ok
834241:Unknown ID or syntax error
8345'
8346not file var:
834921:File var expected
834A'! )
834Dset ptr to std input file
8350* MOV DI,#stdin
8355* PUSH DS
8357type: text file
835B"
835CDo full var: read constant
835Fno good: read var
8361string constant ?
8364no:
836760:Constants are not allowed here
8368JMP
836Aoffset: length of string
836Cemit branch around string constant
836Fsave current pos
8372-> offset of var
8375not indexed
837Asegment CS
837Ftype: array
8384std type: char
838A-> type pointer
838Dno index type
8392length -> component size
8397emit array of char
839Aok
839C'
839Ddo WITH-indexing
83A0:done
83A2search var
83A8not found: try MEM
83AAget var parms
83ADflag: not indexed
83B2indirect by ptr ?
83B7:no
83B9get ptr to var
83BCdo array indexing
83BFdone: loop
83C1do record indexing
83C4done: loop
83C6do pointer indexing
83C9done: loop
83CBdo string indexing
83CEok
83D0'
83D1search keyword:
83D4MEM / MEMW
83D7not found: ret
83DAget component size
83DCsave it
83DD! [
83E0get int expr
83E3* PUSH AX (segment)
83E6! :
83E9get int expr
83EC! ]
83EF* XCHG DI,AX
83F2* POP ES
83F5get length flag
83F6clr hi
83F8-> component size
83FBtype integer
8400byte ?
8402:no
8404set lower, upper bound
8410'
8412set lower, upper bound
841Evar offset: none
8424indexed
8429segment ES
842Eok
8430"
8431Do WITH indexing
8435with nesting -> count
8437count down
8438:another level to test
843A'
843Bsave counter
843C* 4
843E-> pointer into with-table
8440type
8445position
8449search var (record num)
844Erestore pos, type, counter
8451not found: do next level
8453flag: not indexed
8458indexed WITH ?
845B:yes
845Dget offset from with-table
8464'do record indexing
8466save symtab pos
8467get stack offset
846Bstack usage
846E- position
8470-> offset
8473lexical nesting
8476-> var segment
8479get pointer to var
847Crestore symtab ptr
847D"do record indexing
8480Do string indexing
8485no string: ret
8487[ ?
848Ano: ret
848Cpoint to char type
8492-> type ptr
8495"get index
8497Do array indexing
849Cno array: ret
849E[ ?
84A1yes: do it
84A3'
84A4flag: emit PUSH ES
84A7segment ES ?
84AC:no
84AEset flag
84B3indexed ?
84B8:no
84BAset flag: emit PUSH DI
84BFpush entry
84C2save PC, flag
84C7evaluate expression
84CArestore
84CBflag = 0 ?
84D0:yes
84D2restore flag
84D5old PC
84D6anything emitted ?
84DAconstant ?
84DC:yes
84DEsave
84E0load result
84E5restore entry
84E8test flag
84EA:not set
84ECindexed ?
84F1:no
84F3* POP DI
84F8segment ES ?
84FD:no
84FF* POP ES
8504string ?
8509:no
850Bcomponent type = scalar
8510lower bound
8516component size - 1
851A-> upper bound
851D'
851Findex type ptr
8523get type parms
8526type ptr
852Aget type parms
852Dtype = index type ?
8531no:
853444:Type mismatch
8535constant index ?
8537:no
8539get result
853C< lower bound ?
8540yes: error
8542> upper bound ?
8546no: ok
854845:Constant out of range
854B'
854Csubtract lower bound
8550* component size
8556add to var offset
855A'store it
855Dlower bound
8560range check ?
8566:yes
8568lower bound * component size
856Esubtract from var offset
8572'-> faster array indexing
8574subtract lower bound from index
85760:done
85781 ?
857B:no
8580* DEC AX
8582'
8587* SUB AX,#lower_bound
858Cupper bound-lower bound+1
8594* MOV CX,#ind_count
8597(range check)
859A* CALL xindchk
859Dindex * component size
85A0component size = 1 ?
85A3yes: ok
85A5= 2 ?
85A8:no
85AD* SHL AX,1
85B0'
85B2= 4 ?
85B5:no
85B7* SHL AX,1
85BA* SHL AX,1
85BF'
85C1= 6 ?
85C4:no
85C6* SHL AX,1
85C9* MOV CX,AX
85CE* SHL AX,1
85D2'* ADD AX,CX
85D4* MOV CX,#compo_size
85DA* MUL CX
85DDalready indexed ?
85E2:no
85E4add to previous index
85E7* ADD DI,AX
85EA'
85EF* XCHG DI,AX
85F1flag: indexed
85F6component type = array ?
85FBno: end it
85FD, ?
8600no: end it
8602'get next index
8605! ]
8608ok
860A"
860BDo record indexing
8610no record: ret
8612. ?
8615no: ret
8617record nesting level
861Bvar
861Dsearch subvar
8620not found:
862341:Unknown ID or syntax error
8624save base parms
862Cget var parms
862Frestore offset
8630add to new offset
8634restore indirection ptr
8638ok
863A"
863BDo pointer indexing
8640no pointer: ret
8642^ ?
8645no: ret
8647type ptr
864Bget type parms
864E* LES DI,pointer_var
8651emit instruction
8654offset = 0
865Asegment = ES
865Findexed
8664ok
8666"
8667Emit instruction with addressing
866AES ?
866C:stack segment
866Eemit segment prefix
8671indexed ?
8676:yes
8678mode: direct
867Cemit DX
867Fget offset
8682emit offset
8685'ret
8687get offset
868Atest offset
868C[DI]
868E:yes
8690short or long offset ?
8693short
8695:ok
8697long offset
8699set addressing mode
869Bemit opcode
869Eoffset ?
86A1no: ret
86A3'emit offset
86A5in current procedure ?
86A9[BP]offs / [BP+DI]offs
86AC:yes
86AE* MOV BX,[BP]lex_level
86B1(get ptr from display)
86B4- nesting level * 2
86B8emit offset
86BB* SS:
86C0[BX]offs / [BX+DI]offs
86C3indexed ?
86C8:no
86CAuse [B.+DI]
86CCget offset
86CFshort or long ?
86D2short
86D4:ok
86D6long
86D8set addressing mode
86DCemit opcode
86DFget offset
86E2long ?
86E5:no
86E7emit word offset
86EA'
86ECemit byte offset
86EF"
86F0Short or long offset ?
86F2:negative
86F4high byte must be zero
86F6'
86F7high byte must be FF
86FA"
86FBemit segment prefix
8700DS:no prefix needed
8702ES ?
8707(ES:)
8709:yes
870B(CS:)
870Demit prefix
8710"
8711Get offset
8716:stack segment
8718var offset
871Bindexed ?
8720:yes
8722'* MOV DI,#offset
8725test offset
87270:ret
8729short or long offset ?
872C(ADD DI,#byte)
872F:short
8731(ADD DI,#word)
8733save offset
8734emit operation
8737offset
8738short ?
873B:no
873D'emit byte offset
8740'emit word offset
8743(LEA DI,..)
8746"get effective addr -> DI
8749Get var ptr: get var
874Cnot found:
874F41:Unknown ID or syntax error
8750get offset -> DI
8753(PUSH DS) push offset
8755DS ?
875A:yes
875C(PUSH ES)
875EES ?
8763:yes
8765(PUSH SS)
8767:yes
8769(PUSH CS)
876B"emit op
876ELoad var
8773:no scalar
8775ES ?
877A:SS: no shortcuts
877Cindexed ?
8781:no
8783(MOV)
8785byte ?
878A:no
878C(MOVB)
878EMOV AX,...
8790emit instruction
8793'byte: clr hi byte
8795emit segment prefix
8798(MOV AX,var)
879Abyte ?
879F:no
87A1(MOVB AL,var)
87A3emit operation
87A6emit offset
87ACbyte ?
87B1:no
87B6* XOR AL,AL
87B9'
87BAload other types
87BF:no ptr
87C1LES AX,ptr_var
87C4emit instruction
87CA* MOV DX,ES
87CD'
87CEget ptr -> DI,stack
87D1(load real)
87D4real ?
87D9:yes
87DB(load string)
87DEstring ?
87E3:yes
87E5emit set crunch factor
87E8(load set)
87EB"emit call
87EEStore var: emit range check
87F1scalar ?
87F6:no
87F8SS ?
87FDyes: no shortcuts
87FFindexed ?
8804no: optimize
8806(MOV dest_var,AX)
8808byte ?
880D:no
880F(MOVB dest_var,AL)
8811mode
8813'emit instruction
8816emit segment prefix
8819(MOV var,AX)
881Bbyte ?
8820:no
8822(MOVB var,AL)
8824emit opcode
8827emit var offset
882A'
882Dstore ptr: emit store AX
8830offs second word
8835emit store DX
8838'emit instruction
883Bpointer ?
8840:yes
8842(store real)
8845real ?
884A:yes
884Cstring ?
8851:no
8853get string length
885B* MOV CL,max_len
885E(store string)
8861'emit call
8863set crunch factor
8866(store set)
8869"emit call
886Ccalculate set crunch factor
8870get parms of base type
8873component size
8876lower bound/8
887E"* MOV CX,#crunch
8881Emit range check
8886no scalar: ret
8888range checking on ?
888E:no
8890lower bound-1 = upper bound ?
8898yes: no check
889Arestore lower
889B* MOV CX,#lower_bound
889Eupper bound
88A1* MOV DX,#upper_bound
88A4(range check)
88A7emit call
88AA"
88ABread numeric constant
88AEno good:
88B141:Unknown ID or syntax error
88B2"
88B3get integer constant
88B6integer ?
88B9no:
88BC22:Integer constant expected
88BD"
88BEget string constant
88C1string ?
88C4yes: ok
88C6char ?
88C9no:
88CC32:String constant expected
88CDconvert to string
88CF"
88D0Read constant: test sign
88D3save it
88D4get constant element
88D7restore sign
88D8:ok
88DAdidn't work
88DC25:Int or real const expected
88E0ok
88E1'
88E2test type
88E5:ret - no negation
88E7real ?
88EA:no
88EC0 ?
88F1yes: don't negate
88F3negate it
88F8'ok
88FAnegate result
88FCok
88FE"
88FFTest sign:test char
8903flag: negative
8906- ?
8909:yes
890Bclear neg flag
890C+ ?
890Fno: don't skip char
8911set + flag
8912skip that char
8913read next word
8916"
8917Test type
8919:no negation - ok
891Binteger ?
891E:ok
8920real ?
8923no:
892625:Int or real constant expected
8927clear plus flag
8928"
8929Get const element: immediate const
892C:no
892E'
892Fsearch constant
8935:not found
8937get component type
893Ascalar ?
893D:no
893Fget value
8942'ok
8944real ?
8947:no
8949get real const
894Cstore in buffer
895B'ok
895Dstring: get length
8962dest buffer
8965test len
8967:done
8969stored backwards !
896Aget char
896Dcopy into buffer
896Fnext pos
8970another char ?
8972'
8974ok
8976"
8977get immediate constant
897Bcurrent char
897D ' ?
897Fyes: string const
8981^ ?
8983yes: string const
8985# ?
8987no: numeric const
8989dest buffer
898Clength = 0
898Ecurrent char
8990^ ?
8992:yes
8994# ?
8996:yes
8998 ' ?
899Ano: end of string const
899Cnext char
899Dget char
899Fline end ?
89A1yes:
89A455:String constant exceeds line
89A5 ' ?
89A7:no
89A9test next char: may be ''
89AA ' ?
89ADno: end of string
89AFstore in buffer
89B1next pos
89B2count length
89B4'continue
89B6next char: do ^char
89B7get it
89B9UpCase
89BC0 ?
89BEyes:
89C155:String constant exceeds line
89C2make it a control char
89C4next char
89C5store in buffer
89C8count length
89CA'get next element
89CCread #char
89CDsave dest ptr, counter
89CFpos of number
89D1read integer
89D4set new position
89D6restore
89D8error:
89DB56:Error in int constant
89DC'store it, continue
89DEstring
89E0length = 1 ?
89E3:no
89E5get char
89E9clear high byte
89EBchar
89ED'get next word
89F0numeric constant: beg pos
89F2$ ?
89F4yes: integer constant
89F6char in 0..9 ?
89F9:yes
89FBset flag: invalid
89FE'
89FFnext char
8A00get it
8A02in 0..9 ?
8A05yes: loop
8A07UpCase
8A0AE ?
8A0Cyes: real constant
8A0E. ?
8A10no: integer constant
8A12test next char: .. ?
8A15. ?
8A17:yes, integer constant
8A19) ? (.) = ])
8A1Byes: integer constant
8A1Ddest buffer
8A20read real number
8A23set new position
8A25error:
8A2857:Error in real const
8A29real
8A2B'end it
8A2Dread integer const
8A30set new pos
8A32get result
8A34ok ? no:
8A3756:Error in integer constant
8A38integer
8A3A"end it
8A3CEmit inline code
8A3D(stored as inline string)
8A3Estack frame
8A40get return addr
8A44get length
8A46next byte
8A47get byte
8A4Aemit it
8A4Dnext one
8A50:another
8A52restore ret, BX
8A55restore
8A57"
8A58Emit string, CH=length
8A5Aemit length
8A5Dbuffer ptr
8A60test length
8A62:null string
8A64get char
8A66emit it
8A69next one
8A6C'
8A6E"
8A6F* PUSH AX
8A74"
8A75* POP AX
8A7A"
8A7B* PUSH DI
8A80"
8A81* MOV AX,#..
8A86"emit immediate value in AX
8A88* MOV BX,#..
8A8D"emit immediate
8A8F* MOV CX,#..
8A94"emit immediate
8A96* MOV DX,#..
8A9B"emit immediate
8A9D* MOV DI,#..
8AA2"emit immediate
8AA4* CALL ..
8AA9'emit offset
8AAB* JMP ..
8AB0dest-PC-2 -> offset
8AB6"emit offset word
8AB8emit DX
8ABAemit AX
8ABDsave it
8ABEemit high byte
8AC0emit byte
8AC3restore
8AC4"
8AC5Emit byte in AL
8ACA:no PUSH AX
8ACCsave
8ACD* PUSH AX
8AD3reset flag
8AD8emit PUSH ES ?
8ADD:no
8ADFsave
8AE0* PUSH ES
8AE5restore
8AE6reset flag
8AEBemit PUSH DI ?
8AF0:no
8AF2save
8AF3* PUSH DI
8AF8restore
8AF9reset flag
8AFEsave
8AFFfind runtime error ?
8B04:yes
8B06code ptr-code pos of buffer
8B0E+ beg of code buffer
8B12dest segment
8B17store byte
8B19'
8B1BPC = error pos ?
8B23:yes - found !
8B25inc code pointers
8B2Dget PC
8B31overflow ?
8B33:yes
8B35256 bytes done ?
8B37:no
8B39test for overflow
8B3Crestore BX
8B3D'
8B3E98:Memory overflow
8B41'
8B42C8:Error position found
8B45"
8B46Flush code buffer
8B4Bnot to file:ret
8B4Dcode pointer
8B51= code pos of buffer ?
8B56yes: nothing to flush
8B58write byte block
8B5Adest file handle
8B5Ebeginning of code buffer
8B62save DS
8B63dest segment
8B67write buffer
8B6Arestore DS
8B6B:error
8B6Dlength = expected ?
8B6F:yes
8B71C9:File error
8B74'
8B75code ptr -> code pos of buffer
8B7B"
8B7CPatch jump address
8B7Fdest (AX)-src (BX)-2
8B83save dest
8B84dest-PC+code ptr
8B8Cpatch it
8B8Frestore
8B90"
8B91Patch word AX at pos BX
8B96find error:ret
8B98>= code pos of buffer ?
8B9Cno: put it into patch list
8B9Esave pos
8B9F-code pos of buffer
8BA3+beg of code buffer
8BA7dest segment
8BACpatch it in memory
8BAErestore
8BAF'
8BB0save regs
8BB1patch list is sorted to
8BB2minimize disk accesses
8BB3SS -> ES
8BB5start of patch list
8BB9top of patch list
8BBDat the end ?
8BBFyes: put it there
8BC2put it here ?
8BC4:yes
8BC6go to next entry
8BC9'continue searching
8BCBcalculate count to shift
8BCFend position
8BD1-> end pos+4
8BD6save DS
8BD7SS -> DS
8BD9make space for new entry
8BDCrestore DS
8BDDpoint to dest pos
8BDEstore in patch list:
8BDFaddress
8BE2value to be patched
8BE5add 4 to patch top
8BEApatch list top = end of
8BEEpatch list space ?
8BF2:no
8BF4flush patch list
8BF7restore registers
8BFA"
8BFBPatch code in file
8C00no file - ret
8C02save regs
8C07seek relative
8C0Adest file handle
8C0Eget current pos in file
8C15save it
8C17start of patch list
8C1Bend reached ?
8C1F:yes
8C21seek absolute
8C24dest file handle
8C28file offset
8C30+ patch addr
8C33carry
8C36do seek
8C39get value to patch
8C3Cstore in buffer
8C3Fwrite patch value
8C41dest file handle
8C452 bytes
8C48buffer ofs
8C51C):File error
8C52next patch list entry
8C55'
8C57clear patch list:
8C5Abeg -> top
8C5Dseek absolute
8C60dest file handle
8C64restore current pos
8C66set it again
8C69restore regs
8C6E"
8C6Fsave entry 2 on stack
8C72'
8C74save entry 1 on stack
8C77ret addr
8C7Bsave CX
8C7FSS -> ES
8C8315 bytes
8C86make space on stack
8C88dest: stack
8C8Cmove it
8C8Drestore CX
8C91"return
8C95restore entry 2 from stack
8C98'
8C9Arestore entry 1 from stack
8C9Dret addr
8CA1save CX
8CA5SP -> source
8CA7DS -> ES
8CABSS -> DS
8CAF15 bytes
8CB4move it
8CB5restore DS
8CB9remove entry from stack
8CBB"return
8CBDcopy entry 2 from stack
8CC0'
8CC2copy entry 1 from stack
8CC5save CX
8CC6source: on stack
8CC8skip ret addr, CX
8CCBDS -> ES
8CCFSS -> DS
8CD315 bytes
8CD8copy it
8CD9restore DS
8CDDrestore CX
8CDE"
8CDFstore AL in symtab
8CE3down one byte
8CE4store it
8CE7set new symtab top
8CEB"
8CECstore AX in symtab
8CF0down two bytes
8CF2store it
8CF5set new symtab top
8CF9"
8CFAWrite symtab offset
8CFDlast entry-current+2
8D04store offset
8D07symtab top ->
8D0Asymtab top at beg of definition
8D0D"test size
8D10store type
8D13store tag: subtype
8D16symtab top
8D19-> type ptr
8D1Csource buffer
8D1Fdestination
8D23go down
8D24write size, upper bound,
8D25lower bound, component type
8D27get word
8D29store it
8D2Cend ?
8D30:not yet
8D32set new top
8D36write offset
8D39ok
8D3B"
8D3CGet var parms -> entry 2
8D3F'
8D41Get var parms
8D44var segment
8D47var offset
8D4Dtype pointer
8D50to entry 1
8D53save
8D548 bytes
8D57go down
8D58copy size, upper & lower bound,
8D59component type
8D5Bcopy entry -> buffer
8D60:another
8D62restore
8D63"
8D64'Read symbol
8D67'no numbers, verify in symtab
8D69numbers allowed
8D6C'
8D6Eno numbers
8D70save flag
8D71read word
8D74restore flag
8D75numbers allowed ?
8D77first char ?
8D7A:no
8D7C0..9 ?
8D7Fyes: ok
8D81valid char ?
8D84no:
8D8758:Illegal char in ID
8D88verify in symbol table ?
8D8A:no
8D8Ctest if duplicate
8D8Ftest if keyword
8D92destination
8D96word length
8D9A-> count
8D9Cgo down
8D9Dstore length
8DA0go down
8DA1get char from buffer
8DA5store in symtab
8DA8go back
8DA9:another char
8DABset new symtab top
8DAFgo to end of word
8DB3"get next word
8DB6read word: word available ?
8DBByes: ret
8DBFchar ptr: source
8DC3get char
8DC5char in alphanum ?
8DC8:no
8DCAend of buffer ?
8DCD:yes - don't store
8DCFdo UpCase
8DD1:no
8DD5go to next pos
8DD6store char in buffer
8DDAnext char from source
8DDBget it
8DDDin alphanum ?
8DE0yes: loop back
8DE2'no: end
8DE4go to next pos
8DE6store char
8DEAnext char
8DEC. ?
8DEE:yes
8DF0= ?
8DF2:yes
8DF4> ?
8DF6:no
8DF8store that char
8DFEstore word length
8E02store end addr of word
8E06word available
8E0B"
8E0Csearch whole symbol table
8E0Fnot found:ret
8E11"get next word
8E14current var fence
8E18'(BX=search limit)
8E1Astart of symtab
8E1Etype wanted
8E20= type of current word ?
8E24:yes
8E26save fence
8E27read word
8E2Arestore
8E2Bstore type wanted
8E2Fsearch in symbol table
8E32:not found
8E34store type returned
8E37store pos in symbol table
8E3Bget symtab pos
8E3Fget end pos of word
8E43type -> CX
8E45compare type
8E49'
8E4Atype returned: none
8E4Fnot found
8E50"
8E51word length
8E55-> count
8E57symtab position
8E5BSS -> ES
8E5Dforward search
8E5Efence reached ?
8E60yes: not found
8E62add offset
8E65get tag byte
8E680 ?
8E6Ayes: invisible entry
8E6Csubtype ?
8E6Eyes: invisible
8E70string length
8E73= searched ?
8E75:no
8E77= wanted type ?
8E79:no
8E7Bcalculate string position
8E80- count
8E82word ptr
8E85save count
8E87do comparison
8E89restore count
8E8Anot the same: continue
8E8Cget type
8E8Fset ptr to beg of string
8E92= beg of entry
8E94found !
8E95'
8E96not found
8E97"
8E98check keyword: read word
8E9Breturn addr
8E9Dget offset between words
8EA0get pointer
8EA3skip inline parms
8EA6restore ret addr
8EA7distance between keywords
8EA9word ptr
8EACCS -> ES
8EAEforward search
8EB0get length
8EB4nothing - end of list
8EB6-> count
8EB7source
8EBAcompare words
8EBB:equal
8EBDadd remaining count
8EBFadd offset
8EC1'try next keyword
8EC3flag: not found
8EC4'
8EC5position in keyword table
8EC7get next word
8ECBget word from keyword table
8ECD"
8ECECheck keyword: read word
8ED1return address
8ED3inline parm: pointer
8ED5skip inline parm
8ED7restore ret
8ED8word ptr
8EDBget length of keyword
8EDD-> count
8EE0CS -> ES
8EE2compare words
8EE5:not the same - ret
8EE7"ok, get next word
8EEAnew ID = keyword ?
8EEDpointer: list of keyword areas
8EEEget offset
8EF0end of table ?
8EF3:yes
8EF5save pointer
8EF7get pointer into table
8EFAcheck it
8EFDrestore pointer
8EFEyes:
8F0153:Reserved word
8F02next entry
8F05'do next one
8F07"
8F08Duplicate ID ?
8F0Cexpected type
8F10search in symbol table
8F13:ret
8F1543:Duplicate ID or label
8F18"
8F19Check [, (.
8F1D[ ?
8F20yes: skip it
8F22( ?
8F25no: ret
8F27next char
8F28. ?
8F2B'check it
8F2DCheck ], .)
8F31] ?
8F34yes: skip it
8F36. ?
8F39no: ret
8F3Bnext char
8F3C) ?
8F3F'check it
8F41: ?
8F43'check it
8F45semicolon ?
8F47'check it
8F49, ?
8F4B'check it
8F4D. ?
8F4F'check it
8F51( ?
8F53'check it
8F55) ?
8F57'check it
8F59= ?
8F5B'check it
8F5D^ ?
8F5Fcurrent char = AL ?
8F63compare
8F65no: ret
8F67skip it
8F68'read next word
8F6B"
8F6Cexpect [: check [
8F6Fno:
8F728:[ expected
8F73"
8F74expect ]: check ]
8F77no:
8F7A9:] expected
8F7B"
8F7Cexpect :
8F7Fno:
8F822:':' expected
8F83"
8F84expect semicolon
8F87yes: ret
8F891:Semicolon expected
8F8C'
8F8Dexpect semicolon
8F90yes: ret
8F92flag set ?
8F97yes: error 1
8F9941:Unknown ID or syntax error
8F9C"
8F9Dexpect ,
8FA0no:
8FA33:',' expected
8FA4"
8FA5expect (
8FA8no:
8FAB4:'(' expected
8FAC"
8FADexpect )
8FB0no:
8FB35:')' expected
8FB4"
8FB5expect =
8FB8no:
8FBB6:'=' expected
8FBC"
8FBDexpect :=
8FC0check token
8FC2no:
8FC57:':=' expected
8FC6"
8FC7expect OF
8FCAcheck token
8FCCno:
8FCF15:OF expected
8FD0"
8FD0This routine skips spaces until next word is reached.
8FD1get next word: get char ptr
8FD5flag for semicolon error
8FDAsearch flag
8FDFget char (two, actually)
8FE1space, control ?
8FE3yes: skip spaces
8FE5 '{' ?
8FE7yes: comment
8FE9 '(*' ?
8FECyes: comment
8FEEset char pointer
8FF2ok
8FF4'
8FF5skip spaces: get char
8FF8'loop back
8FFAComment: get char
8FFDsave
8FFEcomment type
9000$ ?
9004yes: compiler directive
9006get char
9009test two chars
900B '(*' ?
900E:no
9010now '*)' ?
9013no: loop back
9015end of comment - get char
9018'continue scanning
901A '}' ?
901Cno: loop back
901Erestore
901F"continue scanning
9021Compiler directive: save regs
9024get char
9027get char
902Aget directive
902CUpCase
902FI ? I/O-error handling, Include
9031flag
9034:yes +-
9036R ? Range checking
903B:yes +-
903DB ? I/O-mode (CON or TRM)
9042:yes +-
9044C ? Control C and S
9049:yes +-
904BU ? User Interrupt
9050:yes +-
9052K ? Stack check
9057:yes +-
9059V ? Type checking
905E:yes +-
9060D ? Device checking
9065:yes +-
9067G ? Input file buffer size
9069dest var: buffer size
906C:yes #
906EP ? Output file buffer size
9070dest var: buffer size
9073:yes #
9075F ? Max number open files
9077dest var: max files
907A:yes #
907Cno flag
907EA ? Absolute code
9080:yes +-
9082W ? WITH nesting
9084:yes #
9086X ? Array optimization
9088:yes +-
908AO ?
908C:yes #
908Eremember pos
9091'93:Invalid compiler directive
9092restore regs
9095'continue scanning comment
9098+/- directive: get char
909Bread it
909Dclear flag
909F '+' ?
90A1:yes
90A3set flag
90A4 '-' ?
90A6:yes
90A8include ?
90AByes: do it
90AD'Invalid compiler directive
90AFold directives
90B2invert if reset bit
90B4set / reset bit
90B6invert if reset bit
90B8set new directive
90BBget char
90BE ',' ?
90C2no: end directive
90C4'yes: loop back
90C7Ignore directive: get char
90CCvalid char ?
90CFyes: continue
90D1'another directive ?
90D3Get number: get char
90D6save dest ptr
90D7position
90D9read integer
90DCnew position
90DEdest ptr
90DF:error
90E10 ?
90E3yes: error
90E5store result
90E7'another directive ?
90E9Set include file: space ?
90ECno: do it
90EEget char
90F1'skip spaces
90F3include file active ?
90F8yes:
90FB96:Illegal nesting of include files
90FCposition
90FEparse filename, default .PAS
9101save pos
9102copy path name
9105-> include filename buffer
9108restore pos
9109open file
910Cname ptr
910FDS -> ES
9111open it
911490:File not found
9118store file handle
911Bsave compiler directives
9121clear vars:
9123buffer ptr
9126buffer end
9129relative pos in file
912Cset include flag
9131display line number
9134"restore regs, continue scanning
9137Get char
9139go to next one
913Aend of line ?
913C:yes
913E'
913Fsave regs
9142last line ?
9147yes:
914A91:Unexpected end of source
914Bcount lines
914Fdestination: line buffer
9152up to 127 chars
9155from include file ?
915A:yes
915Cpointer into text
9160-> beginning of source line
9164get char
9166^Z ?
9168yes: mark end of source
916Anext char
916BCR ?
916Dyes: end of line
916Fstore in buffer
9171next pos
9172:another char
9174'end it
9176LF ?
9179no: forget it
917Byes: skip it
917C'set new pos
917Eset flag: end of source
9181store new pos in buffer
9185'mark end of line
9187buffer pointer
918Brelative pos in file
918E+ buffer offset
9190- buffer end
9194-> pos of line begin
9197get char from include file
919A^Z ?
919C:yes, close include
919Enext char
919FCR ?
91A1yes: end of line
91A3store char in buffer
91A5next pos
91A6:another char
91A8'end it
91AAget char from include file
91ADLF ?
91AFno: forget it
91B1skip
91B2store buffer ptr
91B6'mark end of line
91B8clear include flag
91BDrestore directives to
91C0state before include
91C3close
91C5file handle
91CCstore a 0 at the end
91CFgo to beg of buffer
91D2display line number
91D5restore regs
91D8"
91D9Get char from include file
91DD:not yet end of buffer
91DFsave
91E0read byte block
91E2file handle
91E6128 bytes
91E9buffer ptr
91EC?
91EFread buffer
91F2restore
91F3:ok
91F5nothing read
91F7start of buffer
91FAanything read ?
91FC:yes
91FEstore ^Z
92011 char
9202relative pos in file
9206pos of buffer end
920Bget char
920D"
920EDisplay line number
9213:once every 16 lines
9215'
9216save regs
921Awrite CR
921Finclude ?
9224:no
9226I
9228'
922Aspace
922Cwrite it
922Fwrite space
9234get line number
9237display it
923AKeypressed
923Dtest flag
923F:no
9241write string
925DY or N ?
9260no: continue
9262CA:Compilation aborted
9265'
9266clear 32 bytes
9269write BS space BS
9270:another
9272restore regs
9276"
9276*** Start of Tables ***
9276Standard definitions
955E"
9568 Standard types
9568 link  type  lower upper size  tag: invisible
9569integer
9575char
9581real
958Dboolean
9599text file
95A5byte
95B1pointer
95BDstring
95C9untyped file
95D5"typed file
95E0Patch table to patch in pointers to type entries
95E0Offsets relative to 9277
960D"
9613Pointers into keyword table
9614(offset between entries, pointer)
9628"end of table
9629Keyword table
968D'
9692other reserved words
969A'
969Ddefinition part
96A4byte at the end = token
96D1'
96DCprogram part
96E2word = vector to compiler routine
971E'
971Fkeywords used with FOR
9722JGE / INC CX / DEC CX
972DJNG / DEC CX / INC CX
9731'
9732special arrays
9737(not reserved)
973D'
973DCode descriptors: parameters for the code generator
973D+0:operation #
973D+1:opcode immediate form
973D+2:standard opcode
973D+4:option bits
973D    1:XCHG CX,AX needed
973D    2:no immediate form available
973D    4:no var form available
973D    8:CWD needed
973D"   10:XCHG DX,AX needed at end
973EMultiplication ops
9740no imme, IMUL CX
9747real only !
974CAND AX,CX
9755IDIV CX
9759no imme, both XCHG, CWD
975EIDIV CX
9762no imme, XCHG CX,AX, CWD
9767SHL AX,CL
976Bno imme, no var, XCHG CX,AX
9770SHR AX,CL
9774no imme, no var, XCHG CX,AX
9779'
977AAddition ops
977CADD AX,CX
9781SUB AX,CX
9783XCHG CX,AX
9788OR AX,CX
9790XOR AX,CX
9799'
979AComparison ops
979Ctable offset, branch op: JZ
97A1JNZ
97A6JGE
97ABJNG
97AFJG
97B3JL
97B8special
97BA'
97BB"CMP AX,CX; XCHG CX,AX
97C0Standard procedures
97C8vector to COMPILER routine
9A51"
9A52Standard functions
9A56vector to COMPILER routine
9BF4"
9BF4*** End of Turbo 3.0 ***
