@L}5 _$% l0$)$$Hȱ$ UhL" `e$$%`$%`  R@W!( L(1   Y I`  d  Ld M * @  $ % CC$$)%1 Udߥ$9%: !0 S$% DD˙`  }J)Lr  STRING127 = ARRAY [1..127] OF CHAR; STRPOINTER = ^STRRECORD; STRRECORD = RECORD STRFOUND:STRING}127; NEXTSTR :STRPOINTER END;D; STRRECORD = RECORD STRFOUND:STRINGAFUNCTION PARSELINE:STRPOINTER;VAR BASE,TRAILER,LEADER : STRPOINTER; LINE : ^STRING127; X,Y } : INTEGER;BEGIN LINE:=POINTER(1280); X:=1; BASE:=NIL; TRAILER:=NIL; REPEAT IF LINE^[X] = ' ' THE}N X:=X+1 ELSE BEGIN NEW(LEADER); LEADER^.NEXTSTR:=NIL; IF BASE=NIL THEN BASE:=LEADER  } ELSE TRAILER^.NEXTSTR:=LEADER; TRAILER:=LEADER; FOR Y := 1 TO 127 DO LEADER^.STRFOUND[Y }]:=' '; Y := 1; WHILE (ORD(LINE^[X]) <> 155) AND (LINE^[X]<>' ') AND (X < 128) DO BEGIN  } LEADER^.STRFOUND[Y] := LINE^[X]; Y := Y + 1; X := X + 1 END END UNTIL (X>127) OR  }(ORD(LINE^[X])=155); PARSELINE:=BASEEND; Y := Y + 1; X := X + 1 END END UNTIL (X>127) OR - PATHSTRING = ARRAY[1..20] OF CHAR; NAMEARRAY = ARRAY[1..7] OF PATHSTRING; FIELD_TYPE = (ALPHA_FIELD, INTEGER_FIELD,} REAL_FIELD);= ARRAY[1..20] OF CHAR; NAMEARRAY = ARRAY[1..7] OF PATHSTRING; FIELD_TYPE = (ALPHA_FIELD, INTEGER_FIELD, FYLE : PATHSTRING; MERGENAME : NAMEARRAY; KTYPE : FIELD_TYPE; RLEN,OSET, ORDER,KLEN, FNUM },SELECT : INTEGER;THSTRING; MERGENAME : NAMEARRAY; KTYPE : FIELD_TYPE; RLEN,OSET, ORDER,KLEN, FNUM procedure merge(var mergenames:namearray; select,fnum,rlen,klen,oset,order:integer; k}type:field_type);type rectype =array [1..1024] of char; filname =file of char; bufftype=array [1..5] of rectype;} stiltype=array [1..5] of boolean;var i,it,j :integer; buffers :bufftype; stillopen :stiltype; f } :array [1..7] of filname; empty,temp:boolean; function compare(var buff:bufftype; oset,kle}n,order,fnum:integer; ktype:field_type; stillopen:stiltype):integer; type } sortrec = record case field_type of alpha_field :(str:array[1..255] of char); } real_field :(r:real); integer_field:(i:integer); end;(*sort rec*) var i,i2,comp,re}sult:integer; bigger,first :boolean; temp,test :sortrec; begin first:=true; for }i:=1 to fnum do if stillopen[I] then begin for i2:=1 to klen do temp.str[i2]:=bu}ff[i][oset+i2]; if first then begin comp:=i; first:=false; } for i2:=1 to klen do test.str[i2]:=buff[comp][oset+i2]; end(*if*) }else begin case ktype of alpha_field: begin i2:=0; } repeat i2:=i2+1; if test.str[i2]temp.str[i2] then result:=-1 else } result:=0; until (result<>0) or (i2=klen) ; !} end;(*alpha*) integer_field :begin if test.itemp.r then &} result:=1 else result:=0; '} end;(*real*) end; (*case*) if ((result=-1) and (order>=0)) or (} ((result=1) and (order<0)) then begin comp:=i; for i)}2:=1 to klen do test.str[i2]:=buff[comp][oset+i2]; end;(*if*) *} end;(*else*) end;(*still open*) compare:=comp; end;(*compare*)begin(*merge main*) case ktype of +} alpha_field : ; integer_field: klen:=2; real_field : klen:=8; end; for i:=1 to fnum do begin,} reset(f[i],mergenames[i]); for j:=1 to rlen do if eof(f[i]) then stillopen[i]:=f-}alse else begin read(f[i],buffers[i][j]); stillopen[i]:=true; end; .} end; rewrite(f[select],mergenames[select]); empty:=false; while not empty do begin it:=compare(buf/}fers,oset,klen,order,fnum,ktype,stillopen); for j:=1 to rlen do write(f[select],buffers[it][j]); 0} for j:=1 to rlen do if eof(f[it]) then begin stillopen[it]:=false; temp:=fa1}lse; for i:=1 to fnum do temp:=temp or stillopen[i]; empty:=not(temp);2} end else read(f[it],buffers[it][j]); end;(*while*)end;(*merge main*)temp);wPROCEDURE ESORT;(* GLOBAL INPUTS: FYLE : FILE TO BE SORTED RLEN : RECORD LENGTH OSET : BYT4}E OFFSET FROM START OF RECORD TO KEY ORDER : 0 OR + IF ASCENDING NEGATIVE IF 5}DESCENDING KLEN : KEY FIELD LENGTH IN BYTES KTYPE : TYPE OF KEY FIELD ALPHA_FIELD, INT6}EGER_FIELD, OR REAL_FIELD *)VAR FYLELIST :NAMEARRAY; I, FILEINDEX,r :INTEGER; 7} (* INDEX TO FYLELIST PATHLIST *) PROCEDURE MAIN;CONST MAXBYTES = 5000; (* MAX NUMBER OF BYTES IN ARRAYA *) MAXR8}ECORDS = 1000; (* MAX NUMBER OF RECORDS TO LOAD *)TYPE NODEPTR = ^NODE; NODE = RECORD 9} INDEXA : INTEGER; NEXTNODE : NODEPTR END;VAR ARRAYA : ARRAY [1..MAXB:}YTES] OF CHAR; BASE,CURRENT, TARGET : NODEPTR; F,G : FILE OF CHAR; I,J, RECLIMIT, (* NUM;}BER OF RECORDS WHICH FILL ARRAYA *) KEYLENGTH, (* ACTUAL LENGTH OF KEY FIELD IN BYTES *) RECNUMBER, (* NUMBER OF RE<}CORDS READ SO FAR *) SORTORDER, (* ORDER OF SORT (-1,0,1) *) NEXTPOINTER : INTEGER; DOINGPURGE, FOUND_EOF, =}NEEDNEWFILE : BOOLEAN;PROCEDURE INIT_ESORT_VARS;BEGIN DOINGPURGE:=FALSE; NEEDNEWFILE:=FALSE; FILEINDEX:=1;>} CASE KTYPE OF ALPHA_FIELD : KEYLENGTH:=KLEN; INTEGER_FIELD : KEYLENGTH:=2; REAL_FIELD : KEYLENGTH:?}=8 END; RECLIMIT := MAXBYTES DIV RLEN; IF RECLIMIT > MAXRECORDS THEN RECLIMIT:=MAXRECORDS; BASE:=NIL; TARGET:=@}BASE; RECNUMBER :=1; NEXTPOINTER:=1; IF ORDER < 0 THEN SORTORDER:=-1 ELSE SORTORDER:=1END;PROCEA}DURE NAME_TEMP_FILES;(* APPEND SUFFIXES TO FILES IN FYLELIST .1 THRU .6 *)VAR I,J:INTEGER;BEGIN I:=1; REPEAT I:=I+1 B}UNTIL ((FYLE[I]=' ') OR (I=62)); FOR J:=1 TO 6 DO BEGIN FYLELIST[J]:=FYLE; FYLELIST[J][I]:='.'; FYLELC}IST[J][I+1]:=CHR(J+ORD('0')) END; FYLELIST[7]:=FYLEEND;FUNCTION COMPARE(FIRST,SECOND:NODEPTR):INTEGER;(* FIRST,SECD}OND POINT TO NODES WHICH CONTAIN THE INDEXES TO RECORD DATA IN ARRAYA. FUNCTION RETURNS -1 IF FIRSTSECOND FUNCTION VALUE IS REVERSED BY 'ORDER' *)TYPE KEYRF}ECTYPE = RECORD CASE FIELD_TYPE OF ALPHA_FIELD :(CVALUE:ARRAY[1..255] OF CHAR);G} INTEGER_FIELD:(IVALUE:INTEGER); REAL_FIELD :(RVALUE:INTEGER) H} END;VAR I,RESULT :INTEGER; FIRSTKEY, SECONDKEY:KEYRECTYPE; DONE :BOOLEAN;BEGIN FOR I:=0 TO KEYLENGTH-1 I}DO BEGIN FIRSTKEY.CVALUE[I+1] :=ARRAYA[FIRST^.INDEXA +I+OSET]; SECONDKEY.CVALUE[I+1]:=ARRAYA[SECOND^.INDEXA+I+J}OSET]; END; CASE KTYPE OF ALPHA_FIELD : BEGIN I:=0; REPEAT I:=I+1; IF FK}IRSTKEY.CVALUE[I]0) OR (I=KLEN); M}END; (* CASE ALPHA_FIELD *) INTEGER_FIELD : BEGIN IF FIRSTKEY.IVALUETARGET DO X} WALKER:=WALKER^.NEXTNODE; WALKER^.NEXTNODE:=TARGET^.NEXTNODE END;END;PROCEDURE WRITENODE;VAR I :INTEGY}ER; OLDTARGET:NODEPTR;BEGIN IF TARGET=NIL THEN TARGET:=BASE; NEXTPOINTER:=TARGET^.INDEXA; FOR I:=NEXTPOINTER TOZ} NEXTPOINTER+RLEN-1 DO WRITE(G,ARRAYA[I]); IF NOT DOINGPURGE THEN REMOVENODE; OLDTARGET:=TARGET; TARGET:=TARGE[}T^.NEXTNODE; DISPOSE(OLDTARGET); NEEDNEWFILE:=(TARGET=NIL); (* TARGET=NIL WHEN AT END OF LIST *)END;PROCEDURE GE\}TNODE;(* READ NODE FROM FYLE, PUTTING DATA INTO ARRAYA STARTING AT 'NEXTPOINTER' *)VAR I:INTEGER; CH:CHAR;BEGIN I]}:=0; WHILE NOT (EOF(F) OR (I=RLEN)) DO BEGIN READ(F,CH); ARRAYA[NEXTPOINTER+I]:=CH; I:=I+1 END; IF^} NOT EOF(F) THEN BEGIN NEW(CURRENT); CURRENT^.INDEXA:=NEXTPOINTER; CURRENT^.NEXTNODE:=NIL; INSERTN_}ODE; IF RECNUMBER=RECLIMIT THEN WRITENODE ELSE BEGIN (* ARRAY ISN'T FULL YET SO LINEAR ALLOCATION `}IS OK *) RECNUMBER :=RECNUMBER+1; NEXTPOINTER:=NEXTPOINTER+RLEN END END;END;PROCEDURE PURGE;a}VAR MARKER,OLDTARGET:NODEPTR;BEGIN DOINGPURGE:=TRUE; MARKER:=TARGET; WHILE TARGET<>NIL DO WRITENODE; IF FILEINDEb}X=5 THEN BEGIN MERGE(FYLELIST,1,5,RLEN,KLEN,OSET,ORDER,KTYPE); FILEINDEX:=1; END; FILEINDEX:=FILEINDEX+1c}; REWRITE (G,FYLELIST[FILEINDEX]); TARGET:=BASE; WHILE TARGET<>MARKER DO WRITENODE;END;BEGIN INIT_ESORT_VARS;d} NAME_TEMP_FILES; RESET (F,FYLE); REWRITE (G,FYLELIST[1]); WHILE NOT EOF(F) DO BEGIN GETNODE; IF NEEDe}NEWFILE THEN BEGIN IF FILEINDEX=5 THEN BEGIN MERGE(FYLELIST,1,5,RLEN,KLEN,OSET,ORDER,KTYPf}E); FILEINDEX:=1 END; FILEINDEX:=FILEINDEX+1; REWRITE (G,FYLELIST[FILEINDEX]) ENg}D END; PURGE;END;BEGIN MAIN; MERGE(FYLELIST,7,FILEINDEX,RLEN,KLEN,OSET,ORDER,KTYPE); FOR I:=1 TO 6 DO h} r:=DELETE(FYLELIST[I]);END; MAIN; MERGE(FYLELIST,7,FILEINDEX,RLEN,KLEN,OSET,ORDER,KTYPE); FOR I:=1 TO 6 DO procedure add_device(var instr,outstr:pathstring); begin#a ldy #5 ;pop the arguments lda (_sp),y ;off ofj} the stack sta _t+2 ;and into zero iny ;page memory. lda (_sp),y sta _t+3 iny lda (_sk}p),y sta _t iny lda (_sp),y sta _t+1 ldy #0aloop equ * lda (_t),y ;read from IN iny l} ;string and copy iny ;3 places over iny ;in OUT. sta (_t+2),y dey ;dm}ec y twice dey ;thus inc y once cpy #$11 ;has a maxfile size been copied. bne aloop ;no copn}y next char. ldy #4 lda (_t+2),y ;check for fullpath cmp #': beq fullp iny lda (_t+2),y cmpo} #': beq fullp ldy #02 ;add devicebloop equ * lda $487,y sta (_t+2),y dey bpl bloop p}jmp leavefullp equ * ;full path just normalize. ldy #$ffcloop equ * iny iny iny iny lda (q}_t+2),y dey dey dey sta (_t+2),y cpy #$10 bne cloopleave equ * ;capitalize 1st letter. r} ldy #0 lda (_t+2),y and #$df sta (_t+2),y#end; bne cloopleave equ * ;capitalize 1st letter. Bfunction delete(f:pathstring):integer; var spec:pathstring; begin delete:=0; add_device(f,spet}c);#a stx dxsave ldx #$10dopn1 lda $340,x cmp #$ff beq dopn2 txa clc adc #$10 tax cpxu} #$80 bne dopn1 ldy #$81 jmp dleavedxsave db 0dopn2 lda #$21 ;delete command sta $342,x clc lda v} #5 adc _sp sta $344,x lda #0 adc _sp+1 sta $345,x jsr $e456dleave tya ldy #25 sta (w}_sp),y ldx dxsave#end;,x lda #0 adc _sp+1 sta $345,x jsr $e456dleave tya ldy #25 sta (PROCEDURE SEED(NUM1,NUM2,NUM3,NUM4:INTEGER);BEGIN#A LDY #5SEED1 LDA (_SP),Y STA POLYN-5,Y INY CPY #12 BNE SEED1 ORA y}#1 STA GEN+7#END;FUNCTION RND:REAL;BEGINRND:=0;#A TXA PHA LDA #0 STA _TRAN1 INC _T JSR POLY CMP #0 BEQ RAN1 z}ORA #$10 LDY #5 STA (_SP),Y;RAN2 INY JSR POLY ROL ROL ROL ROL AND #$F0 STA _T+1 JSR POLY ORA _T+1 STA (_SP),Y {}CPY #11 BCC RAN2 LDA _T INY STA (_SP),Y PLA TAX#END;#APOLY TYA PHA LDY #0POLY1 INY CLC ROL POLYN ROL POLYN+1 |} ROL POLYN+2 ROL POLYN+3 ROL POLYN+4 ROL POLYN+5 ROL POLYN+6 ROL POLYN+7 BCC POLY3; LDX #0POLY2 LDA POLYN,X EOR GEN }},X STA POLYN,X INX CPX #8 BCC POLY2 SEC;POLY3 ROL _T+2 CPY #4 BCC POLY1; PLA TAY LDA _T+2 AND #$0F CMP #$0A B ~}CS POLY RTS;GEN DB $A1 DB $A2 DB $1A DB $A2 DB $91 DB $C3 DB $93 DB $C0;POLYN DB $63 DB $42 DB $A1 DB $23 DB }$55 DB $09 DB $03 DB $87#FUNCTION RANDOM(MIN,MAX:INTEGER):INTEGER;BEGIN RANDOM := MIN + TRUNC(RND*(MAX-MIN+1))END; }FUNCTION Random_Byte: Integer; BEGIN RANDOM_BYTE:=0;#A LDA $D20A ;get RANDOM (53770) LDY #5 ;offs }et to ISO_Var STA (_SP), Y ;...store it#END;(* Random Byte function *) $D20A ;get RANDOM (53770) LDY #5 ;offs Kfunction rename(var oldname,newname:pathstring):integer; var temp,fullname:pathstring; begin rename:=$}0; add_device(oldname,fullname); temp:=' ';#a stx rnxsav pla lda #5 $} clc adc _sp sta _t lda #0 adc _sp+1 sta _t+1 ldy #$ffrnloop equ * iny $} lda (_t),y cmp #32 beq rmove cpy #19 bne rnloop ldy #$a5 jmp rleavernxsav db$} 0rmove lda #', sta (_t),y iny tya clc adc _t sta _t+2 lda #0 adc _t+1$} sta _t+3 ldy #47 lda (_sp),y sta _t+4 iny lda (_sp),y sta _t+5 ldy #1$} lda (_t+4),y cmp #': bne rnext ldy #$a5 jmp rleavernext iny lda (_t+4),y cm$}p #': bne rgo ldy #$a5 jmp rleavergo ldy #20rmlop lda (_t+4),y sta (_t+2),y dey $} bpl rmlop ldx #$10ropn1 lda $340,x cmp #$ff beq ropn2 txa clc adc #$10 tax$} cpx #$80 bne ropn1 ldy #$81 jmp rleaveropn2 lda #$20 ;rename command sta $342,x $} lda _t sta $344,x lda _t+1 sta $345,x jsr $e456rleave tya ldy #45 sta (_sp),y $} ldx rnxsav#end;4,x lda _t+1 sta $345,x jsr $e456rleave tya ldy #45 sta (_sp),y $function bsave(var pathname:pathstring; len,dest:integer):integer; var source:pathstring; begin bsave:=0;(} add_device(pathname,source);#a stx bssave ldx #$10 ;iocb1bsopn1 lda $340,x ;ichid,x cmp #$ff beq bsopn2 t(}xa clc adc #$10 tax cpx #$80 bne bsopn1 lda #$81 ldy #25 sta (_sp),y jmp bserrbssave db 0 ;open itbsopn2 lda #3 (}sta $342,x clc lda _sp adc #5 sta $344,x lda #0 adc _sp+1 sta $345,x lda #8 sta $34a,x ;set aux1 lda #0 sta $34b,(}x ;set aux2 jsr $e456 bpl *+5 jmp bseave ;perform the read lda #$0b sta $342,x ldy #27 lda (_sp),y sta $344,x iny(} lda (_sp),y sta $345,x iny lda (_sp),y sta $348,x iny lda (_sp),y sta $349,x jsr $e456bseave tya ldy #25 sta (_s(}p),y lda #$c sta $342,x jsr $e456bserr equ * ldx bssave#end;sp),y sta $349,x jsr $e456bseave tya ldy #25 sta (_s(Dfunction get_free_iocb():integer; begin get_free_iocb:=0;#a stx _t ldx #$10gfopn1 lda $340,,}x cmp #$ff beq gfopn2 txa clc adc #$10 tax cpx #$80 b,}ne gfopn1 ldx #$81gfopn2 txa ldy #5 sta (_sp),y ldx _t#end;% cpx #$80 b,ffunction bload(var pathname:pathstring; len,dest:integer):integer; var source:pathstring; begin bload:=0;0} add_device(pathname,source); if len=0 then len:=maxint;#a sta blsave ldx #$10 ;iocb1blopn1 lda $340,x ;i0}chid,x cmp #$ff beq blopn2 txa clc adc #$10 tax cpx #$80 bne blopn1 ldy #25 lda #$81 sta (_sp),y jmp blerrblsave0} db 0 ;open itblopn2 lda #3 sta $342,x clc lda _sp adc #5 sta $344,x lda #0 adc _sp+1 sta $345,x lda #4 sta $34a,0}x ;set aux1 lda #0 sta $34b,x ;set aux2 jsr $e456 bpl *+5 jmp bleave lda #7 sta $342,x ldy #27 lda (_sp),y sta $30}44,x iny lda (_sp),y sta $345,x iny lda (_sp),y sta $348,x iny lda (_sp),y sta $349,x jsr $e456bleave tya ldy #250} sta (_sp),y lda #$c sta $342,x jsr $e456blerr equ * ldx blsave#end;sp),y sta $349,x jsr $e456bleave tya ldy #250Mfunction lock(var fylename:pathstring):integer; var fullname:pathstring; begin lock:=0; add_d4}evice(fylename,fullname);#a stx lxsave ldx #$10lopn1 lda $340,x cmp #$ff beq lopn2 txa 4} clc adc #$10 tax cpx #$80 bne lopn1 ldy #$81 jmp lleavelxsave db 0lopn2 lda 4}#$23 sta $342,x lda #5 clc adc _sp sta $344,x lda #0 adc _sp+1 sta $344}5,x jsr $e456lleave tya ldy #25 sta (_sp),y ldx lxsave#end;#0 adc _sp+1 sta $344[PROCEDURE Scan_File(VAR FN,Target: String15; VAR Position: Integer);VAR Result,Where,I,IX,Len: Integer; F: Text;BEGIN8} Where:=1; Len:=0; IX:=0; REPEAT Len:=Len+1; UNTIL (Len=15) OR (Target[Len]=' '); IF Len>0 THEN BEGIN I:=1; 8}Reset(F,FN); REPEAT IF Target[I]=F^ THEN I:=I+1 ELSE BEGIN IX:=8}IX+I; I:=1 END; Get(F) UNTIL (EOF(F)) OR (I=Len+1); Where:=IX END; IF I<=Len TH8}EN Where:=-1; Position:=WhereEND;(* scan file *)et(F) UNTIL (EOF(F)) OR (I=Len+1); Where:=IX END; IF I<=Len TH84function unlock(var fylename:pathstring):integer; var fullname:pathstring; begin unlock:=0; a<}dd_device(fylename,fullname);#a stx unsave ldx #$10uopn1 lda $340,x cmp #$ff beq uopn2 t<}xa clc adc #$10 tax cpx #$80 bne uopn1 ldy #$81 jmp uleaveunsave db 0uopn2 l<}da #$24 sta $342,x lda #5 clc adc _sp sta $344,x lda #0 adc _sp+1 sta <} $345,x jsr $e456uleave tya ldy #25 sta (_sp),y ldx unsave#end;#0 adc _sp+1 sta <_FUNCTION Format(drivenum:integer; density :char):Integer;BEGIN format:=0;#A stx _t ldy #8@} lda (_sp),y cmp #1 bcs f.OK ldy #160 jmp f.leavef.OK cmp #9 bcc f.nxt ldy@} #160 jmp f.leavef.nxt adc #$30 sta fdrive+1 ldy #7 lda (_sp),y and #$DF cmp #'S@} beq s.den cmp #'D beq d.den ldy #146 jmp f.leaves.den lda #253 sta _t+1 jm@}p f.doitd.den lda #254 sta _t+1f.doit ldx #$10fopn1 lda $340,x cmp #$ff beq fopn2 txa @} clc adc #$10 tax cpx #$80 bne fopn1 ldy #$81 jmp f.leavefdrive asc 'D1:' db @} $9bfopn2 lda _t+1 sta $342,x lda #0 sta $34a,x sta $34b,x lda #>fdrive sta $344@},x lda #gstr sta $344,x lda #= LEADING? BCS *+4 `} ;YES:FILL WITH #RTS4C LDY #$20 ;BLANKSRTS4D TYA LDY #19RTS5 STA (_T+3),Y ;FILL STRING DEY BPL RTS5 CMP `}#'# BEQ RTS99 ;EXIT IF OVERFLOW BIT _T+8 BPL RTS5A DEC _T+10RTS5A EQU * BIT _T+8 BVC RTS6 LDY _T+7 ;IF EXP`} WAS MINUS, USE LEADING ZERO BIT _T+8 ;# NEG ALSO? BPL RTS5B ;NO DEY DEY LDA #'- STA (_T+3),Y INY BNE *+3`}RTS5B DEY ;PUT ZERO TO LEFT OF . LDA #'0 STA (_T+3),Y INY BNE RTS10 ;AND WRITE REMAINDER OF NUMBERRTS6 EQU *`} SEC LDA _T+7 SBC _T+10 ;START @ LEADING - EXPONANT - 1 TAY DEY BIT _T+8 ;NEED MINUS SIGN? BPL RTS7 LDA #'-`} DEY STA (_T+3),Y INYRTS7 JSR RTS20 ;PUT SIG# IN _T+9 IN STRING @ Y INY CPY _T+7 BNE RTS7 ;WRITE ALL LEADING DI`}GITSRTS10 LDA _T+6 ;# OF DEC. PLACES BEQ RTS99 ;IF NONE WE'RE DONE LDA #'. ;Y IS ALWAYS = _T+7 STA (_T+3),Y `} ;WRITE DEC. POINT BIT _T+8 ;USING NEG EXP? BVC RTS11 ;NO LDA #'0RTS12 EQU * DEC _T+10 BEQ RTS11 INY `} ;INSERT LEADING ZEROS STA (_T+3),Y DEC _T+6 BEQ RTS99 BNE RTS12RTS11 INY JSR RTS20 ;PUT REMAINDER OF # IN D`}EC _T+6 ;UNTIL ALL DEC. REQUESTED WRITTEN BEQ RTS99 CPY #19 ;OR STRING FILLED BNE RTS11RTS99 LDX _T#END;#`}ARTS20 EQU * STY _T+5 CLC LDA _T+9 ;SIG DIGIT # (1-13) LSR ;/2 TAY LDA (_T+1),Y LDY _T+5 BCC RTS21 `} ;C=0 FOR EVEN SIG# AND #15 ;STRIP UPPER NIBBLE ADC #$2F ;2F+1 FOR CARRY = $30 BNE RTS22 ;ALWAYSRTS`}21 AND #$F0 ;STRIP LOWER LSR LSR LSR LSR CLC ADC #$30RTS22 STA (_T+3),Y INC _T+9 RTS;RTSE EQU * ;RETURN NUMB`}ER IN SCI NOTATION LDY #$20 ;ASSUME SPACE AS LEADING CHAR BIT _T+8 ;# NEG? BPL *+4 LDY #'- TYA LDY #0 STA `}(_T+3),Y ;FIRST CHAR EITHER BLANK OR - INY JSR RTS20 ;PRINT 1ST DIGIT LDA _T+6 ;# OF DEC PLACES BEQ RTSE2 I`}NY LDA #'. STA (_T+3),Y ;PUT IN DECPT NEXTRTSE1 EQU * INY JSR RTS20 CPY #15 BEQ RTSE2 ;PRINT E+/- & END DEC _T`}+6 BNE RTSE1RTSE2 EQU * ;PUT IN E AND EXPONANT INY LDA #'E STA (_T+3),Y LDX #'+ BIT _T+8 ;EXP + OR -? BVC *`}+4 LDX #'- TXA INY STA (_T+3),Y INY LDA #14 ;PRINT EXP VIA RTS20 STA _T+9 JSR RTS20 INY JSR RTS20RTSE4 LDA `}#$20RTSE3 INY CPY #20 ;BUFFER REMAINDER W/BLANKS BEQ RTS99 STA (_T+3),Y BNE RTSE3 ;ALWAYS# JSR RTS20RTSE4 LDA `hPROCEDURE Fill(X,Y,C: Integer);BEGIN#A STX _T ;safety first LDY #5 ;offset to color LDA (_SP),Y ;...get frod}m stack STA $2FB ;...store in ATACHR (763) INY ;offset to vertical INY LDA (_SP),Y ;get value from stack d} STA $54 ;...store in ROWCRS (84) INY ;offset to horizontal INY LDA (_SP),Y ;get val from stack STA $55 d} ;...LSB into COLCRS (85) INY ;offset to horiz MSB LDA (_SP),Y ;...get from stack STA $56 ;...store MSB d} LDX #$60 ;IOCB 6=screen LDA #12 ;fill command STA $342,X ;...store in command byte LDA #$C ;18 for fill d}STA $34a,X ;...part of Gr. screen LDA #$00 ;zero out STA $34b,X ;...auxillary #2 JSR $e456 ;CIO will take care d} LDX _T#END;(* Fill procedure *) LDA #$00 ;zero out STA $34b,X ;...auxillary #2 JSR $e456 ;CIO will take care d#PROCEDURE Disable_Key_Click;BEGIN#A LDA #$FF ;put 255 into STA $2DB ;...(731)#END;(* Key Click Off procedure *)PROCh}EDURE Enable_Key_Click;BEGIN#A LDA #$00 ;zero out STA $2DB ;...(731)#END;(* Key Click On procedure *)cedure *)PROChnPROCEDURE GotoXY_in_Text_Window(HX,VY: Integer);BEGIN#A LDY #5 ;offset to VY LDA (_SP),Y ;...get the row value Sm}TA $290 ;...store in TXTROW (656) LDY #7 ;offset to HX LDA (_SP),Y ;...get the column value STA $291 ;...stom}re in TXTCOL (657)#END;(* Text Window Position procedure *)HX LDA (_SP),Y ;...get the column value STA $291 ;...stol>PROCEDURE Disable_IO_Beep;BEGIN#A LDA #$00 ;poke zero into STA $41 ;...SOUNDR (65) for silence#END;(* IO Beep Off prq}ocedure *)PROCEDURE Enable_IO_Beep;BEGIN#A LDA #$FF ;poke 255 into STA $41 ;...SOUNDR (65)#END;(* IO Beep On proceq}dure *)*)PROCEDURE Enable_IO_Beep;BEGIN#A LDA #$FF ;poke 255 into STA $41 ;...SOUNDR (65)#END;(* IO Beep On procepPROCEDURE Fast_Key_Debounce;BEGIN#A LDA #$06 ;poke 6 into STA $2D9 ;...(729)#END;(* Fast Debounce procedure*)PROCEDu}URE Normal_Key_Debounce;BEGIN#A LDA #$30 ;poke 48 into STA $2D9 ;...(729)#END;(* Normal Debounce procedure *)PROCEDu}URE Slow_Key_Debounce;BEGIN#A LDA #$78 ;poke 120 into STA $2D9 ;...(729)#END;(* Slow Debounce procedure *)*)PROCEDtsPROCEDURE Click_Speaker;BEGIN#A LDA #$00 ;poke zero into STA $D01F ;...CONSOL (53279)#END;(* Click procedure *)OCEDxyPROCEDURE Set_Tab; BEGIN WRITE(CHR(159));END;(* set tab procedure *)PROCEDURE Clear_Tab; BEGIN WRI} }TE(CHR(158));END;(* clear tab procedure *)PROCEDURE Tab; BEGIN WRITE(CHR(127));END;(* tab to next stop proced} }ure *)158));END;(* clear tab procedure *)PROCEDURE Tab; BEGIN WRITE(CHR(127));END;(* tab to next stop proced|function copy(var Scr,Dest: pathstring):integer; var fullscr,fulldest:pathstring; begin copy:=0; } add_device(scr,fullscr); add_device(dest,fulldest);#a stx _t jsr c.iocb bpl *+5 jmp cpexit } lda #3 sta $342,x clc lda #25 adc _sp sta $344,x lda #0 adc _sp+1 sta $345,x l}da #4 sta $34a,x lda #0 sta $34b,x jsr $e456 bpl cv1 sty _t+1 jsr c.close ldy _t+1 } jmp cpexitcv1 stx _t+1 jsr c.iocb bpl cv2 ldx _t+1 sty _t+1 jsr c.close ldy _t+1 jmp } cpexitcv2 stx _t+2 lda #3 sta $342,x clc lda #5 adc _sp sta $344,x lda #0 adc _sp+1} sta $345,x lda #8 sta $34a,x lda #0 sta $34b,x jsr $e456 bpl copy jmp c.donecopy eq}u * ldx _t+1 ;source iocb lda #$07 ;get char sta $342,x lda #0 sta $348,x sta $349,x jsr } $e456 bmi c.done pha ldx _t+2 lda #$0b ;put char sta $342,x lda #0 sta $348,x sta $3}49,x pla jsr $e456 bmi c.done jmp copyc.done equ * sty _t+3 ldx _t+1 jsr c.close ldx }_t+2 jsr c.close ldy _t+3cpexit equ * tya cmp #$88 bne cv3 lda #1cv3 cmp #$3 bne cv4 } lda #1cv4 ldy #45 sta (_sp),y jmp cp.end;c.iocb equ * ldx #$10copn1 lda $340,x cmp #$ff beq cop}n2 txa clc adc #$10 tax cpx #$80 bne copn1 ldy #$81copn2 rts;c.close equ * lda #$0C s}ta $342,x jsr $e456 rts;cp.end ldx _t#END;(* Copy function *)$81copn2 rts;c.close equ * lda #$0C sLPROCEDURE Insert_Char; BEGIN WRITE(CHR(255));END;(* insert character procedure *)PROCEDURE Insert_Line; BE}GIN WRITE(CHR(157));END;(* insert line procedure *);(* insert character procedure *)PROCEDURE Insert_Line; BE=PROCEDURE Backspace; BEGIN WRITE(CHR(126));END;(* delete/backspace procedure *)PROCEDURE Delete_Char; BEGI}N WRITE(CHR(254));END;(* delete character procedure *)PROCEDURE Delete_Line; BEGIN WRITE(CHR(156));EN}D;(* delete line procedure *);(* delete character procedure *)PROCEDURE Delete_Line; BEGIN WRITE(CHR(156));ENPROCEDURE Activate_Char_Set(ADR:INTEGER);BEGIN#A LDY #6 ;offset to Loc LDA (_SP),Y ;...get value STA $2F4 ;...st!}ore in CHBAS (756)#END;(* Activate_Char_Set procedure *) ;offset to Loc LDA (_SP),Y ;...get value STA $2F4 ;...st;PROCEDURE Write_ESCape_Char; BEGIN WRITE(CHR(27));END;(* write_ ESC_char *),Y ;...get value STA $2F4 ;...stYPROCEDURE Disable_Cursor;BEGIN#A LDA #$01 ;poke 1 into STA $2F0 ;...CRSINH (752)#END;(* Cursor Off procedure *)PROC$}EDURE Enable_Cursor;BEGIN#A LDA #$00 ;poke zero into STA $2F0 ;...CRSRINH (752)#END;(* Cursor On procedure *)PROCxPROCEDURE Set_Left_Margin(Num:Integer); BEGIN#A LDY #5 ;offset LDA (_SP),Y ;get the value and store STA $52 &} ;...in LMARGIN (82)#END;(* Set Left Margin procedure *)PROCEDURE Set_Right_Margin(Num:Integer); BEGIN#A LDY #5 '} ;offset to Num LDA (_SP),Y ;get the value and store STA $53 ;...in RMARGIN (83)#END;(* Set Right Margin proced(}ure *)ffset to Num LDA (_SP),Y ;get the value and store STA $53 ;...in RMARGIN (83)#END;(* Set Right Margin procedPROCEDURE Enable_Attract;BEGIN#A LDA #$80 ;poke 128 into STA $4D ;ATRACT (77)#END;(* Attract On procedure *)PROCED*}URE Disable_Attract;BEGIN#A LDA #$0 ;poke 0 into STA $4D ;ATRACT (77)#END;(* Attract Off procedure *)dure *)PROCEDnPROCEDURE GotoXY(Horiz,Vert: Integer); BEGIN#A LDY #5 ;offset to Y LDA (_SP),Y ;get value from stack STA $54 ,} ;...store in ROWCRS (84) LDY #7 ;offset to X LDA (_SP),Y ;get val from stack STA $55 ;...LSB into COLCRS (-}85) INY ;offset to horiz MSB LDA (_SP),Y ;...get from stack STA $56 ;...store MSB#END;(* GotoXY procedure.} *)PROCEDURE Goto_Screen_Top; BEGIN#A LDA #00 ;top STA $54 ;ROWCRS LDA #00 ;far left STA $55 ;COLCRS sta/} $56#END;(* goto TOP procedure *)PROCEDURE Goto_Screen_Bottom; BEGIN#A LDA #23 ;bottom STA $54 ;ROWCRS LDA #0}39 ;far right STA $55 ;COLCRS lda #0 sta $56#END;(* goto EOP procedure *)A #23 ;bottom STA $54 ;ROWCRS LDA #TPROCEDURE Set_Background_Color(C: Integer);BEGIN#A LDY #5 ;offset to color LDA (_SP),Y ;get number STA $2C6 ;...2}store in COLOR2 (710)#END;(* set background color procedure *)PROCEDURE Set_Char_Luminance(C: Integer);BEGIN#A LDY #5 3} ;offset to brightness LDA (_SP),Y ;get number STA $2C5 ;...store in COLOR1 (709)#END;(* set character luminance pr4}ocedure *)PROCEDURE Set_Border_Color(C: Integer);BEGIN#A LDY #5 ;offset to Color LDA (_SP),Y ;get number STA $2C85} ;...store in COLOR4 (712)#END;(* set border color procedure *) ;offset to Color LDA (_SP),Y ;get number STA $2C8EPROCEDURE Clear_to_EOLn; VAR CURRENT,Cursor_Pos:Integer; BEGIN#A LDY #5 ;offset to Cursor_Position LDA 7}$55 ;get COLCRS (85) STA (_SP),Y;...store it INY ;offset to MSB LDA #$00 ;zero out STA (_SP),Y;the MSB#8} FOR CURRENT:=Cursor_Pos TO 39 DO WRITE(CHR(254));END;(* Clear_to_End *)PROCEDURE Clear_Screen; BEGIN9} WRITE(CHR(125));END;(* Clear_Screen *)PROCEDURE Clear_to_EOP; VAR Cl_Line,Cl_P :INTEGER; RowCrs,Co:}lCrs:Integer; BEGIN#A LDY #7 ;offset to RowCrs LDA $54 ;...get ROWCRS (84) STA (_SP),Y ;...store in RowCrs;} LDY #5 ;offset to ColCrs LDA $55 ;...get COLCRS (85) LSB STA (_SP),Y ;...store in ColCrs# FOR Cl_Line<}:= ColCrs TO 39 DO WRITE(CHR(254)); WRITELN; FOR Cl_P:=23 DOWNTO RowCrs+1 DO WRITE(CHR(15=}6));END;(* Clear_to_EoP *)PROCEDURE Clear_Ln_at(Y: Integer); BEGIN#A LDA $54 ;get value in ROWCRS (84) STA _T>} ;...store LSB for later LDY #5 ;offset to Y LDA (_SP),Y ;...get Y value STA $54 ;...store in ROWCRS# ?} WRITE(CHR(156));#A LDA _T ;get old row number STA $54 ;restore cursor position#END;(* Clear_Ln_at *) {PROCEDURE Enable_Fine_Scroll;BEGIN#A LDA #$FF ;poke 255 into STA $26E ;...(622)#END;(* enable fine scroll procedure *)A}PROCEDURE Disable_Fine_Scroll;BEGIN#A LDA #$00 ;zero out STA $26E ;...(622)#END;(* disable fine scroll procedure *)){PROCEDURE Enable_Keyboard;BEGIN#A LDA #$00 ;zero out STA $26D ;...(621)#END;(* enable keyboard procedure *)PROCEDURC}E Disable_Keyboard;BEGIN#A LDA #$FF ;poke 255 into STA $26D ;...(621)#END;(* disable keyboard procedure *)*)PROCEDURqPROCEDURE Disable_Break;BEGIN#A LDA #$40 ;poke 64 into STA $10 ;...POKMSK (16) STA $D20E ;...IRQEN (53774)#END;(E}* Disable Break Key procedure *)PROCEDURE Enable_Break;BEGIN#A LDA #$C0 ;poke $C0 into STA $10 ;..POKMSK (16) LDF}A #$F7 STA $D20E#END;(* Enable Break Key procedure *)BEGIN#A LDA #$C0 ;poke $C0 into STA $10 ;..POKMSK (16) LD:PROCEDURE Enable_Screen(Num: Integer);BEGIN#A LDY #5 ;offset to Num LDA (_SP),Y ;...get LSB STA $22F ;...store iH}n SDMCTL (559)#END;(* Enable ANTIC procedure *)FUNCTION Disable_Screen: Integer; BEGIN DISABLE_SCREEN:=0;#A LI}DY #5 ;offset DISABLE_SCREEN LDA $22F ;get SDMCTL (559) STA (_SP),Y ;...store it LDA #$00 ;zero out STA $22F J} ;...SDMCTL#END;(* Disable ANTIC procedure *)et SDMCTL (559) STA (_SP),Y ;...store it LDA #$00 ;zero out STA $22F 1PROCEDURE Freeze_on_Reset;BEGIN#A LDA #$FF ;poke 255 into STA $09 ;...BOOT? (9)#END;(* lockup on reset procedure *)L}PROCEDURE Reboot_on_Reset;BEGIN#A LDA #$01 ;poke 1 into STA $09 ;...BOOT? (9) STA $244#END;(* reboot on reset proM}cedure *) Reboot_on_Reset;BEGIN#A LDA #$01 ;poke 1 into STA $09 ;...BOOT? (9) STA $244#END;(* reboot on reset pro FUNCTION Cursor_X: Integer; BEGIN CURSOR_X:=0;#A LDY #5 ;offset LDA $55 ;peek LSB O} STA (_SP),Y ;...and save it INY ;add 1 for MSB LDA $56 ;peek MSB STA (_SP),P}Y ;...and save it#END;(* CursorX procedure *)FUNCTION Cursor_Y: Integer; BEGIN CURSOR_Y:=0;#A LDY #Q}5 ;offset to LSB LDA $54 ;peek LSB of value STA (_SP),Y ;...and store it#END;(* Cursor Y function*)}FUNCTION STRTOREAL(VAR CONVSTRING:STRING20):REAL;VAR RESULT:REAL;BEGIN#A STX _T LDX #$80 LDY #21 LDA (_SP),Y STA _T+1S} INY LDA (_SP),Y STA _T+2 LDA #0 STA _T+3 ;EXPONANT STA _T+4 ;SIGN BYTE STA _T+5 ;SIG DIGIT INC _T+T}5 STA _T+6 ;. FOUND FLAG STA _T+7 ;COUNTS LEADING ZEROES LDY #5STR1 STA (_SP),Y INY CPY #13 BNE STR1 TAYU}STR2 LDA (_T+1),Y ;SCAN STRING FOR FIRST 1..9 OR . CMP #'- BEQ STRNEG CMP #'. BEQ STRDEC CMP #'1 BCC STR2A CMP #'9+1V} BCC STR3BSTR2A INY CPY #20 BNE STR2 BEQ STR99STRNEG LDA _T+4 EOR #$80 STA _T+4 JMP STR2ASTRDEC LDA _T+4 ORA #$40 W} ;NEG EXPONANT STA _T+4 STX _T+6 ;FLAG DEC FOUND INC _T+3 ;START EXP AT -1 BNE STR5 ;ALWAYSSTR3B X}DEC _T+3STRMAIN EQU * JSR STR20 ;INSERT DIGIT IN A @ _T+5 POSITIONSTR5 INY CPY #20 BCS STR99 LDA (_T+1),Y CMP #'.Y} BNE STR6 STX _T+6 BEQ STR5 ;ALWAYSSTR6 CMP #'0 BCC STR5 CMP #'9+1 BCC STRMAIN BCS STR5STR99 LDA _T+3 ;EXPONAZ}NT LDY #5+7 STA (_SP),Y LSR _T+4 LSR _T+4 LDY #5 LDA (_SP),Y ;FIRST BYTE AND #15 ORA _T+4 STA (_SP),Y ;PUT SIG[}NS IN UPPER NIBBLE LDX _T# STRTOREAL := RESULTEND;#ASTR20 EQU * ;INSERT DIGIT AND ADJUST EXPONANT CMP #'0 BNE STR\}25 BIT _T+4 ;IS EXP MINUS? BVC STR25 ;NO BIT _T+7 BMI STR25 SED INC _T+3 CLD RTSSTR25 BIT _T+4 BVS STR24]} BIT _T+6 BMI STR24 ;SKIP INC IF . ALREADY FOUNDSTR23 SED INC _T+3 CLDSTR24 STX _T+7 STY _T+10 ;SCRATCH SPAC^}E PHA LDA _T+5 INC _T+5 CLC ROR PHP CLC ADC #5 ;ADD STACK OFFSET TAY PLP PLA BCC STR21 ;IF C=0 USE H_}I NIBBLE AND #15STR22 ORA (_SP),Y STA (_SP),Y LDY _T+10 RTSSTR21 EQU * ;USE HI NIBBLE AND #15 ASL ASL ASL ASL`} JMP STR22# #15STR22 ORA (_SP),Y STA (_SP),Y LDY _T+10 RTSSTR21 EQU * ;USE HI NIBBLE AND #15 ASL ASL ASL ASL PROCEDURE INTTOSTR(NUMBER:INTEGER; JUSTIFY:CHAR; VAR RESULT:STRING5);BEGIN#A STX _T LDY #5 LDA (_SP),Y ;ADDRESS OF REb}SULT STRING STA _T+1 INY LDA (_SP),Y STA _T+2 INY INY LDA (_SP),Y ;INTEGER TO CONVERT STA _T+4 INY LDA (_SP),Y c}STA _T+5 LDY #7 LDA (_SP),Y ;JUSTIFY CHAR; LDX #'0 CMP #'Z BEQ ITS2 LDX #$20 ;SPACE CMP #'R BEQ ITS2 TXA d} ;FILL STRING WITH SPACES LDY #4ITS1 STA (_T+1),Y DEY BPL ITS1 LDX #0ITS2 STX _T+3; LDA #0 ;ZERO BCDe} RESULT STA _T+6 STA _T+7 STA _T+8 STA ITSCOPY ;COPY FLAG; LDY #16 ;BIT COUNTER CLC SEDITS3 ROL _T+4 ROL f}_T+5 LDA _T+6 ADC _T+6 STA _T+6 LDA _T+7 ADC _T+7 STA _T+7 LDA _T+8 ADC _T+8 STA _T+8 DEY BNE ITS3; CLD g} ;CHANGE BCD TO ASCII IN STRING LDX #$80 LDY #0 ;INDEX TO STRING LDA _T+8 AND #15 JSR ITS7 ;ENTER @ NIBBq}BPARSET I BPARSELN I B SRTMERGTI BSRTMERGVI B"MERGE I B63ESORT I B iADDDEV I BsDELETE I B xRANDOMS I B RENAME I BBSAVE I BIOCB I BBLOAD I BLOCK I BSCANFILEI BUNLOCK I BFORMAT I BSTICK I BBEEP I BPADDLE I BCURSORS I BGETCHAR I BLOADCSETI BHELPKEY I BRTOS I BFILL I BKEYCLICKI BGOTOXYTWI BIOBEEP I BDEBOUNCEI B CLICK I B TABS I B COPY I BINSERTS I BDELETES I B ACTCSET I B"ESCCHAR I B#CURSOR I B%MARGINS I B)ATTRACT I B+GOTOS I B1COLORS I B 6CLEARS I B@FINSCROLI BBKEYBOARDI BDBREAK I BGSCREEN I BKRESET I BNCURSORPSI BRSTOR I B aITOS I BwCONVTYPSI BxXIO I B}FUNCTKEYI B STOI I BGETDIR I BIDMACH I BCSET I BAPPEND I BIOTYPES I BREPEAT I BM P LE TEST POINT;ITS5 LDA _T+7 JSR ITS8 ;CONVERT MIDDLE BYTE LDA _T+6 JSR ITS8 ;CONVERT LOWEST BYTE BIT ITSCOPr}Y BMI ITS12 LDA _T+3 BEQ *+3 ;IF LEFT JUSTIFY, Y IS CORRECT DEY LDA #'0 ;SINCE NOTHING PASSED YET, PRINT Es}NDING ZERO STA (_T+1),YITS12 LDX _T#END;#AITS8 PHA AND #$F0 LSR LSR LSR LSR JSR ITS7 ;PROCESS THIS NIBBLE t}PLA AND #15ITS7 CMP #0 BNE ITS6 ;AUTO INSERT IF NON-ZERO BIT ITSCOPY ;OK ANYWAY? BMI ITS6 ;YES LDA _T+3 u} ;NO: PUT JUSTIFY CHAR BNE ITS10 ;INTO STRING IN PLACE OF DIGIT RTS ;RETURN IF LEFT JUSTIFYITS6 CLC v}ADC #$30 ;MAKE INTO ASCII DIGIT STX ITSCOPYITS10 STA (_T+1),Y INY RTSITSCOPY DS 1#URN IF LEFT JUSTIFYITS6 CLC _ String5 = ARRAY[1..5] OF Char; String6 = ARRAY[1..6] OF Char; String20 = ARRAY[1..20] OF Char; JUSTIFYITS6 CLC jfunction xio(cmd,iocb,aux1,aux2:integer; var fyle:pathstring): Integer; var fullfyle:pathstring; begin y} xio:=0; iocb:=iocb*16; add_device(fyle,fullfyle);#A stx _t ldy #33 lda (_sp),y taxz} iny iny lda (_sp),y sta $342,x ldy #31 lda (_sp),y sta $34a,x dey dey {}lda (_sp),y sta $34b,x clc lda #5 adc _sp sta $344,x lda #0 adc _sp+1 sta $34|}5,x jsr $e456 tya ldy #25 sta (_sp),y ldx _t#end;x lda #0 adc _sp+1 sta $34QPROCEDURE Function_Key(VAR RESULT:PATHSTRING; Delay: Integer); VAR Key_Pointer: ^CHAR; L,KEY_VAL : Integer; ~} BEGIN RESULT:=' '; KEY_POINTER:=POINTER(-12257); FOR L:=1 TO Delay DO Key}_Val:=ORD(Key_Pointer^); CASE Key_Val OF 0: RESULT:='ALL KEYS '; 1: RESULT:='OPTION SELECT '; Հ} 2: RESULT:='OPTION START '; 3: RESULT:='OPTION '; 4: RESULT:='SELECT START '; 5Ձ}: RESULT:='SELECT '; 6: RESULT:='START '; 7: RESULT:='NO KEYS '; 8: RESՂ}ULT:='CLEARED '; END; (* CASE *)END;(* Function_Key function *): RESULT:='NO KEYS '; 8: RESPFUNCTION STRTOINT(VAR NUMBER:STRING6):INTEGER;VAR RESULT:INTEGER;BEGIN#A STX _T LDY #9 ;STRING ADDRESS LDA (_SPل}),Y STA _T+1 INY LDA (_SP),Y STA _T+2; LDA #0 ;ZERO RUNNING TOTAL STA _T+3 STA _T+4; LDY #5 ;FIND Fم}IRST NON-SPACE CHAR IN STRINGSTI1 LDA (_T+1),Y CMP #$20 BNE STI2 DEY BPL STI1 BMI STI8 ;IF ALL SPACES, RESULT IS ن}ZERO;STI2 LDX #0 ;INDEX INTO PWROFTEN TABLESTI3 LDA (_T+1),Y CMP #'0 BCC STI5 ;TREAT NON-DIGITS AS ZERO CMP #ه}'9+1 BCS STI5 AND #15 ;LEAVES 1..9 IN A BEQ STI5 STY _T+5 ;SAFE TAYSTI4 CLC ;MULTIPLY LOOP IS SLOWEو}R THAN SHIFTING BITS LDA ST10LO,X ;BUT IT'S ALSO MUCH SHORTER ADC _T+3 STA _T+3 LDA ST10HI,X ADC _T+4 STA _T+4 DEY ى}BNE STI4 LDY _T+5STI5 INX DEY BPL STI3 INY ;Y=0 LDA (_T+1),Y CMP #'- ;MINUS SIGN? BNE STI8 ;Nي}O LDA _T+3 EOR #$FF STA _T+3 LDA _T+4 EOR #$FF STA _T+4 INC _T+3 BNE STI8 INC _T+4STI8 LDY #5 LDA _T+3 STA (_SP),ً}Y INY LDA _T+4 STA (_SP),Y LDX _T# STRTOINT := RESULTEND;#AST10LO DB >1 DB >10 DB >100 DB >1000ٌ} DB >10000ST10HI DB <1 DB <10 DB <100 DB <1000 DB <10000# DB >100 DB >1000_function get_dir(var dirname:pathstring; header:elemptr):integer; var fullname:pathstring; wildcard:arrayݎ}[1..4] of char; displace:integer; i,icb,j:integer; temp :elemptr; function open_dir(var naݏ}me:pathstring):integer; begin open_dir:=0;#a stx _t ldx #$10gdopn1 ݐ} lda $340,x cmp #$ff beq gdopn2 txa clc adc #$10 ݑ} tax cpx #$80 bne gdopn1 lda #$81 jmp gdleavegdopn2 ݒ} stx _t+1 lda #$03 sta $342,x lda #6 sta $34a,x lda #0ݓ} sta $34b,x ldy #7 lda (_sp),y sta $344,x iny ݔ} lda (_sp),y sta $345,x jsr $e456 bmi gdleave ldy _t+1gdleave ݕ} tya ldy #5 sta (_sp),y ldx _t# end; function get_dir_rec(io:integer; buݖ}ffer:elemptr):integer; begin get_dir_rec:=0;#a stx _t+5 ldy #9 lda (ݗ}_sp),y tax lda #$07 sta $342,x dey lda (_sp),y sta $3ݘ}45,x dey lda (_sp),y sta $344,x lda #>18 sta $348,x lݙ}da #<18 sta $349,x jsr $e456 bmi gdrleave ldy #7 lda (_sp),y ݚ} sta _t iny lda (_sp),y sta _t+1 lda #32 ldy #18 ݛ} sta (_t),y ;strip off cr ldy #1 lda $348,x cmp #17 bne gdrleave ݜ} ldy #17 lda #32 sta (_t),y ldy #3gdrleave tya ldy #5 sta (_ݝ}sp),y ldx _t+5# end; function close_dir(icb:integer):integer; begin close_dir:=0;#aݞ} stx _t ldy #7 lda (_sp),y tax lda #$c sta $342,X jsr $e456 ݟ} tya ldy #5 sta (_sp),y ldx _t# end; begin wildcard:='*.* '; j:=1; ݠ} add_device(dirname,fullname); displace:=0; if fullname[3]=' ' then displace:=2 elseݡ} if fullname[4]=' ' then displace:=3; if displace<>0 then for i:=1 to 4 do ݢ} fullname[i+displace]:=wildcard[i]; icb:=open_dir(fullname); if icb>112 then get_dirݣ}:=icb else begin while j=1 do begin new(temp); temp^.next:=nil; ݤ} j:=get_dir_rec(icb,temp); if (j=1) or (j=136) then header^.next:=temp; ݥ} header:=temp; end;(*while*) if j=136 then get_dir:=1 else ݦ} get_dir:=j; j:=close_dir(icb); end;(*else*)end;(*get_dir*) get_dir:=1 else UFUNCTION ID_Machine: Char; VAR Holder: Integer; BEGIN#A LDY #5 ;offset to Holder LSB LDA $E40F ;get val}ue here STA (_SP),Y ;...store in Holder INY ;offset to MSB LDA #$00 ;zero out STA (_SP),Y ;...the MSB#IF Hol}der = 56 THEN ID_Machine:='A' ELSE IF Holder = 0 THEN ID_Machine:='B' ELSE } ID_Machine:='?'END;(* get the ROM version procedure *) Holder = 0 THEN ID_Machine:='B' ELSE =PROCEDURE Invert_Char_Set;BEGIN#A LDA #$FF ;poke 255 into STA $2F3 ;...CHACT (755)#END;(* upside-down character set p}rocedure *)PROCEDURE Normal_Char_Set;BEGIN#A LDA #$02 ;poke 2 into STA $2F3 ;...CHACT (755)#END;(* right-side up ch}aracter set procedure *)PROCEDURE Intl_Char_Set;BEGIN#A LDA #$CC ;poke 204 into STA $2F4 ;...CHBAS (756)#END;(* Inter}national Character Set procedure *)PROCEDURE Atari_Char_Set;BEGIN#A LDA #$E0 ;poke 224 into STA $2F4 ;...CHBAS (756)#}END;(* Atari Char set procedure *)PROCEDURE Atari_Char_Set;BEGIN#A LDA #$E0 ;poke 224 into STA $2F4 ;...CHBAS (756)#$function append(var Scr,Dest: pathstring):integer; var fullscr,fulldest:pathstring; begin append:=0;} add_device(scr,fullscr); add_device(dest,fulldest);#a stx _t jsr a.iocb bpl *+5 jmp apex}it lda #3 sta $342,x clc lda #25 adc _sp sta $344,x lda #0 adc _sp+1 sta $345,x } lda #4 sta $34a,x lda #0 sta $34b,x jsr $e456 bpl av1 sty _t+1 jsr a.close ldy _t}+1 jmp apexitav1 stx _t+1 jsr a.iocb bpl av2 ldx _t+1 sty _t+1 jsr a.close ldy _t+1 }jmp apexitav2 stx _t+2 lda #3 sta $342,x clc lda #5 adc _sp sta $344,x lda #0 adc _}sp+1 sta $345,x lda #9 sta $34a,x lda #0 sta $34b,x jsr $e456 bpl aopy jmp a.doneaop}y equ * ldx _t+1 ;source iocb lda #$07 ;get char sta $342,x lda #0 sta $348,x sta $349,x }jsr $e456 bmi a.done pha ldx _t+2 lda #$0b ;put char sta $342,x lda #0 sta $348,x sta} $349,x pla jsr $e456 bmi a.done jmp aopya.done equ * sty _t+3 ldx _t+1 jsr a.close l}dx _t+2 jsr a.close ldy _t+3apexit equ * tya cmp #$88 bne av3 lda #1av3 cmp #$3 bne av4} lda #1av4 ldy #45 sta (_sp),y jmp ap.end;a.iocb equ * ldx #$10aopn1 lda $340,x cmp #$ff beq} aopn2 txa clc adc #$10 tax cpx #$80 bne aopn1 ldy #$81aopn2 rts;a.close equ * lda #$0C } sta $342,x jsr $e456 rts;ap.end ldx _t#END;(* append function *)1aopn2 rts;a.close equ * lda #$0C R PathString = ARRAY[1..20] OF Char; ElemPtr = ^ElementRec; ElementRec = RECORD entry:array[1..17] of char; }next :elemptr END;(*elementrec*); ElemPtr = ^ElementRec; ElementRec = RECORD entry:array[1..17] of char; $PROCEDURE Fast_Key_Repeat;BEGIN#A LDA #$01 ;poke 1 (too fast!) into STA 730 ;...repeat rate location#END;(* Speed Up} Cursor procedure*)PROCEDURE Normal_Key_Repeat;BEGIN#A LDA #$06 ;poke 6 (1/10th sec.) into STA 730 ;...repeat rate l}ocation#END;(* Normal Cursor Speed procedure *)PROCEDURE Slow_Key_Repeat;BEGIN#A LDA #60 ;poke 60 (1 second) into }PROGRAM MOUNTAIN(INPUT,OUTPUT);CONST MAXLEVEL=7; MAXSTRING=14; XRES=319; MAXLEVEL1=7.0; YRES=191; Parallel =Fa}lse; Perspective=True; plot_abs =0; draw_abs =1; move_abs =2; plot_rel =3; draw_r}el =4; move_rel =5;TYPE POINTS=RECORD X,Y,Z: REAL; END; PathString = ARRAY[1..20] OF Char; ElemPtr = ^}ElementRec; ElementRec = RECORD entry:array[1..17] of char; next :elemptr END;(*elementrec*)VAR LEVEL }: INTEGER; (* LEVEL NUMBER *) ST : INTEGER; (* STARTING X COORDINATE OFFSET *) F : FILE OF INTEGER; (* WORK FI}LE *) G : FILE OF INTEGER; (* DATA FILE *) I,J : INTEGER; POINT : POINTS; (* DATA RECORD *) LASTX : REA}L; (* VALUE OF LAST X COORDINATE *) LASTY : REAL; (* VALUE OF LAST Y COORDINATE *) LASTZ : REAL; (* VALUE OF LAST Z C}OORDINATE *) NUMPOINTS: INTEGER; (* NUMBER OF POINTS TO GENERATE EACH LEVEL *) FNAME : STRING[14]; (* FILE NAMES *) C } : CHAR; FNAME1 : PATH;PROCEDURE SEED(NUM1,NUM2,NUM3,NUM4:INTEGER);BEGIN#A LDY #5SEED1 LDA (_SP),Y STA POLYN-5},Y INY CPY #12 BNE SEED1 ORA #1 STA GEN+7#END;FUNCTION RND:REAL;BEGINRND:=0;#A TXA PHA LDA #0 STA _TRAN1 INC} _T JSR POLY CMP #0 BEQ RAN1 ORA #$10 LDY #5 STA (_SP),Y;RAN2 INY JSR POLY ROL ROL ROL ROL AND #$F0 STA _T+1 }JSR POLY ORA _T+1 STA (_SP),Y CPY #11 BCC RAN2 LDA _T INY STA (_SP),Y PLA TAX#END;#APOLY TYA PHA LDY #0POLY1 }INY CLC ROL POLYN ROL POLYN+1 ROL POLYN+2 ROL POLYN+3 ROL POLYN+4 ROL POLYN+5 ROL POLYN+6 ROL POLYN+7 BCC POLY3; }LDX #0POLY2 LDA POLYN,X EOR GEN,X STA POLYN,X INX CPX #8 BCC POLY2 SEC;POLY3 ROL _T+2 CPY #4 BCC POLY1; PLA TAY} LDA _T+2 AND #$0F CMP #$0A BCS POLY RTS;GEN DB $A1 DB $A2 DB $1A DB $A2 DB $91 DB $C3 DB $93 DB $C0;POLYN DB} $63 DB $42 DB $A1 DB $23 DB $55 DB $09 DB $03 DB $87#FUNCTION RANDOM(MIN,MAX:INTEGER):INTEGER;BEGIN RANDOM := }MIN + TRUNC(RND*(MAX-MIN+1))END;FUNCTION Random_Byte: Integer; BEGIN RANDOM_BYTE:=0;#A LDA $D20A ;get RA}NDOM (53770) LDY #5 ;offset to ISO_Var STA (_SP), Y ;...store it#END;(* Random Byte function *)function Get_Char}(VAR Ch: Char):integer; BEGIN get_char:=0;#a stx _t ldy #7 lda (_SP),y sta _t+1 iny lda (_SP}),y sta _t+2 ldx #$10gcopn1 lda $340,x cmp #$ff beq gcopn2 txa clc adc #$10 tax cpx #$80} bne gcopn1 ldy #$81 jmp gcleavegcopn2 stx _t+4 lda #3 sta $342,x lda #4 sta $34a,x lda #0 } sta $34b,x lda #>gstr sta $344,x lda #device send errors to devicepc: D}恥J鏐쩛J` %HH! % %hh` debug code掎6΍ "ɛ;> - "L!6L}#6 "L!L#ʩ慀 "L!` "dop5sAL#̍L#̍L~"L# "L# "`͍L#͍L~"}L#΍L~" "ɛL"` "-L#L# "ɛʩ:ɛȱ: `ȱ a}{8 `A[i `# % %L)error in command line #as #ɛ'ʩ -o} ȹɛ͍ #L)*ȹɛ.pȹ厙ɛ` %% % %ɛ % %`#`} p.out % L#ɛ L#ɛ  L$`т`A [ a{͇`A[i `0:}͇` %`- %8倅偅$$L$$$$$L$ 0 %ץ 0 %` d'}ƍɛ#!Ƚɛ!HƍhɛHh`͍ % %`opening source and object filesclosing source and }object filesopening include fileclosing include fileL% ȱ %` %` %ɛ`HJJJJ %h) 0:i}L%`H0 BHIh V`H &h`lč͍. %፩BDEHI V0`L'H8``*% %}⍩BDEJK VL' BD#EJK VL'`6`č%ō0B6DEJK VL'`}厮䎝'H BDEHI VL'h`J% % + L+ BDE䎝HI VL'L+č+}0L+j% %:&ɛ":" "ɛL'"ɛ"a {8 "@፩B"DEJK} V0`L{% %፭⍍L+HH %H( %h愀 焀#06@" %hH % %h `( %L)pc:} DOS error on file: ~( Z(( %`((((())')<)U)e)q))) - error codenon-existent devic}edevice or file not opendevice timeoutdisk drive # errortoo many open disk files disk fullfatal disk I/O errorinternal }file # mismatchfile name error file lockedinvalid disk commanddirectory fullfile not found )L"*+,`}X@ԩ67آ +iWE:  + + )LR % 򺢀  #0ɛ% }!lDO Sl ::#)ߍ Һ0 ( ɺHE Һ0L( ɺ} Һ0L(H ɺ Һ0 ( ɺh=Ɉɪɥ- MHJJJJOh)PiBi L *}DEHIB V[cŰűΥQDE V0BDE8尝H屝IHI V0 ɺ}lH ɺL*hhhhXL B V`BDEJK V`H BHIh V`DE BHI V`B}DEHI V`Error Code - Bad Load FileFile Not FoundFile Name ErrorNot a Load FileInvailid Device0123456789A}BCDEFD𩛍 ,텀, jt`_lomem 8 +? 7 - x7 (- +? 8` 8( 8` 7 8 :8` +? }E- a- - - - +? I0` 8ɑ 8` 7 +? 8 x7` 8Ʌ 8` 7m +? 7 1n +? x7 8 8ɧ` 8ɟ 8` 7# +? 7 T2$ +?} x7 8 8ɧ` 8ɡ 8` 7 +? 8 7 +?L- 7 T2 +? x7 8 8ɧ` 8 8ɘ . x7L-ɍ U. x7L-` 8 7V +? 8 8}( 3 x7 8 8ɧ 8W +? (-X +?` 7g +?` 8 7+ +? 8;+ 8( 3 7 7, +? x7 8 8ɧ 7- +?`. +? (-/ +?` 8 }8ɧɄ` . 8; 8` .` 7 +? 8 7 +?L. 7 T2 +?` 8 / +? 7 ?/ 8 8; 8 8 8ɧɨ+-ɳ` 7 }8: 8 +?` +? 7 +?` 1u +? 8 1 +?LG/ 7 8 +? . +? :8` +? 8 8ɨ 7 +? 7 8ɧL/Ƀ 8LI0ɏ}Ld0ɄL0ɢL0ɛL1ɌL!1ɣLk1ɎL1 8` 8 7 8 8ɴW[D.@^< sL6 dsL6 *tLT7 sL 7L +? 8 8}( z4M +?` 3 J8 49 +?`8 +? J8 49 +?` 8 n/ 8;Ɋ 8 x7LL0` 4d +? 8 n/ 8 8ɉ 8e +? n/f +?`} +? 4~ +}? 7 0 8 8Ɋ x7 8 8 3 +? 8` 1 +? 8 1 +?L0 7 +? n/ +?`a +? 4b +? 7 n/c +?`_ +? n/ 8; 8 }*8 4` +?` 7Z +? J8 4[ +? K1 4\ +? 7 n/Y +?` 8ɞ Ɉ 87 {`] +?`^ +?` +? 3 +? 8 7 n/ +?` 7 +?` }8ɳ 8 1 1s +?` +?` 8 8ɨ ɧ 2 { 1` 7t +?` 8+ - 8p +?`q +?`r +?` 7 8. ɱ& 8 +?` +? 7 }+? 8ɱ 8 +?` +? 8ɨ+- 8% {` 8 7 +?` 7 +?` +? 8 8ɧL2ɨL2+L2-L2ɳL2(L2 8 }^LW3ɗ 8ɂL33ɋL`3ɜLl3ɚLx3 {` 8( 8ɨ,+(-$ɳ ɧ0 {`% +? 7& +? 8 :8` 1 +? j8 1 +?` } 7 8 8ɲ! +?`v +? +? j8 1 +?`( +? z8 2) +? 8 Z8 7 T2* +?` 70 +?` 7 T2 +?` 7 2 +?` +? . +? }8`ɧɨ +-ɳ` 72 +? 8[ .^" 8` 43 +? 8 Z8L3 74 +?L35 +?L3 8h +? 3 8; 8 :8` 8 8ɧL4}LB4ɘLi4ɍLm4 {` 7S +? 8 7T +?L&4 7 7U +?` 8 7i +? 8 7j +?LM4 7 7k +?` 7` 7 7 8 7` 8(} 8` 4 8 :8` qT 3l +?` T 7` 4" +?` "5 8=< >$ɮ(ɰ,ɯ0ɐ4 8`: +?L5< +?L5= +?L5; +?L5> }+?L5? +?L5x +? "5@ +?` "5w +?` Y5 8+ -ɖ 8` t5A +?L%5 t5B +?L%5 t5G +?L%5 8- + 8 t5` t5I +?` 5 8}*/Ɇ"ɒ)Ɂ0 8` 5C +?Lw5 5D +?Lw5 5E +?Lw5 5F +?Lw5 5H +?Lw5 +? 8ɨ7ɳ?ɧL$6(ɔ[Lg6ɓL6:} {` 4 :8` 5J +?` 8 1K +?`1 +?`' +?` 8 7 8 8([&."^6 +?`y +? 8 8( z4z +?` 37 +?` +? 8 8]} 6 +? 8 6 +?L~6 Z8` 4 8ɲ 8 +?` +? 4 +?` 8 8(O +?` 6N +?` 8P +? 6Q +? 8 6L6 :8` 4 8 }8:R +?` 7 4 8 8:{ +?` 7 4| +?` 8 8( +?` 8 3 +? 8 3 +?L;7 :8 +?` 8 3 +? 8 3 +?L_7} :8 +?` 8;  { 8;` 8ɧ 8 {`ȹ̉` 8ɨ 8 {`ȹ̉` 8: 8 {` 8ɇ 86 {` }8= 8 {` 8ɕ 8 {` 8Ɋ 8 {` 8ɝ 84 {` 8ɠ 85 {` 8) 8 {` 8ɴ 83 {` 8] 8 {}` 8ɲ 8 {` 8[ 8 {` 8ə 8 {` 8. 8 {` 8( 8 {` 8Ƀ  { 8Ƀ` 8, 8``}` 8`ɛ C:L8!쎶ζeE [$` 6$L9 [$L9'L9:=:`詴`...`該`}<=><`詰`詮`>=>`詯`(*L :(`{{` P$Ƚ_ 6$ [$ʌ ;`ș [$ʌ}`ɛ H] {hL :''L9ʌ H\ {h`ɛ C:L :} *轉)L8 : ;̍Dp}qP t# P$a |:LC:` :#轉 &ɛL|: ;` & >;L: : :L:`# ]; }i``- {` ]; , {` ̉ ];+ { X'`= { '}`ɛ!􎶍ζ P$șɛ!팉`΍; &ȹ &ɛ` $;%;$ȱ >}HȱhL;`<$<)<3ąȥT ,A AA`#}   @ @ȱ :>ȱȥ A ,A` @-> >ă ,A`  @ @$} >ȱ)T ȱ >e {LK> ,A AA` @ ȥq) ii ,A`Z%}[e揥Ŏ台@ {`тȱтΈ`i >ȹ̉XY`ι#&}&ibi?ȱl`EEF F?ME'kYkkkkkkkklllh6iriiiiMFF-G;G]GGTKKGGUH(HQH|II'}JJdJKUNOPQeQRRRDSearaaaaaaVghgzgg4h=hahjhhhS+TPTbb ccc'Kȱȥzȭ{ @` A AAȱł4Ń.zȭ{ȱ6}ȱ 0E @`k {f { @L;G }= = ,A @ @ iȥi` A ,Aqȥq87}ȱȥ ȥńмŅж` 1s @` > @` ,A @ȱiȱi }= =8}ȥȥ` @` @ @ @ @ Bn {` @ @ @ H H >ȥȥ9}ȥŮůл @` ȱ`ȱ8񬅰ȥ񬅱`ȱ&&e:}eD {` %p @,^ { }= = @ȥiiT` 0J` JT ;B` { A oT` %p;} @,_ { }= = @ȥiiT`z { 1s ,A @ ȥȱ e<}ȱe` {T A o` 0J { {` A A o GȱHȱ`W { J =}JT ;B` pȱq E t ȱȱ / { t` t` t`p>}qpipqiqVrWsG t`w {` A @ n ,A @ @` A @ n` 1sȱ AA kA @ ȱ?}ȱeeȥ ȥ8 ȥȱа ȥ` }= = @` A ,Aȥ` >@} @ ?ȥȩ` A @ n ,A @ @` A @ n` 1s AA kA @ ȱȱiiA}ȥ ȥ8 ȥȱЪ ȥ` }= = @` A ,Aȥ +zȭ{B}` >ȥ|`i >ȥȹ̄``+`-`` A @ i {-8C}zz{{`-|I |` pT {ȱȱS { @ z{`|`ȱD}̄`z{q @` > @ȩȹ̄` }= = Bȥ` p {E}pȱqrsm t` p {pȱqn t` > ,Aȱȥ @` È F}p LK]g { 3O`pȱq E t tpȱqi tȱ @` ȱ @ PO t`pȱqG} T!rs tȱu t` t` E t` @ @ {ȱȱ @ P 9PpȱqH}p q t`p q t` t`ȱŢţ`Šš` {5pȱqp qI} t88ppȱqq t`pȱq8ppqq t` A {ȱ {ȱJ} >ȱLPȱ @pȱqi t` A U {ȱ @`ȱ pK}ȱ @ t`V { È N VR` p!L6RL=RLK]g { 3O VR`ȱ @ :pL}ȱqC t`I tȱpqJ t`ȱpqQ tȱpqJ tĄ` TV V`M} @ a[` VR` @ Hȱh @!   ` t` t` t` t` ÈLN pN}  } { 3O`_Y pȱqrrsitȱiu ȱ @rT E t` t`h {O} ,A A NS` {DX {  t+pȱqrȱs tȱ  tP}` t` t` t`pȱq t` A @`zp{qC t`I tq|pHJ th` p  N Q}{ zV` @ @`ȱ V` A ,A a[`; A ,A @ @*&ȱ `` f\`R}5 A ,A @ @!ȱ`` WLW ,A AA~ {ȱ ȱ NSȱ @ S}]` WLW A ,A~ {ȱ ŀȱŁ tȱ @ ]` {pqC tU @` pT}qC tq @`pqQ t > @ȩȹpqHJ th̉` p  O { TV` @ @ @U}`ȱ V` A ,A a[` ȱ ȱ @ zV` @ ȱ @ ]` A~ { A V}ȱpȱq tpȱqK t`T E tL t` tL t`ȱ`` AiȱW}iȱȱ XWYWlWWWWWXX(XHXdXmXXXXXXXYLYsYY'ZHZ|ZZZZ [ O[ȥ X} C {y t`z t` O[sȩq` *[{ t` O[ D( {pȱq t` O[ȩq& {` *[| t` O[ \ Y}t` O[eȩq 0 {` O[eȩq G {` *[ t` O[ 0 {pȱq t` *[ t` O[ \Z} t` O[eȩq { t` O[sȩq B {` O[ G {` O[& {qȩr` O[ȥ[} BK {pqpq t` O[ 0 {pȱq t` 1) {pq  0 {\}pȱqC t` D( {pȱqC t` 1) {pq  0 {pȱqC t` D( {p]}ȱqC t` O[sȩq1 { t` ) { 0 {`& { t` *[ t` O[ȥ^}  C { t` t` *[ t` O[ȥ BK {pqpȱq8ppqq t` O[sȩ_}q1 { t` O[ȩq  C { t``) {L[ L[L[L \LI\LZ\`}* {`eȩqr t} t`eȩqr t~ t`r tpqC tpqC tpqC t t`a}M tpqC tpqC tpqC t t`M t t`* {`+;- ) % +b} ``````` ' {ȱ p"ȱpȱq`V { @ @c}8ȱpq ȱpȱqO t ,A AA`q @r t`M t` A B B @pqg t` d}Bpqe t ,A @pq u` Apq u` B @pq u` A B B @pqg t` A ,Apqe te}pq u` B @pq u` A B Apqg t` A T p[ {TZ {Y {f}ȥ ȱ BK {ȥȱ ȱ Bȥ Bȥ Bȥg}` Aȱ B` Aȱ B @_ a_ a_pȱq u`pȱq )S t`T t`Hȱh}pȱqrȱs thpȱq E )_ t`UVWX` `pȱqrȱstȱuiviwi} )F` tpȱq E J` tpȱqe tpȱq u A`YZ[\]^_`abcd A Bȥ Bj}ȥpq E t` A BK {ȥ t`pql tpȱq u A` Aŀ8ȱŁ1pȱk}q E t tzp{qC t t` { `; t` Bȥpqg t`pȱqe tpȱq u`ma b`l}$,za b`%-a b` &a b`!'a b`"(.a b`#)/ A @ B {` ,A AP {ȱ Bm} {0 t a`eq @` ,A AA Aeq @ 1 t  t B { n}# # D t` t` t` t`pȱq t` A @ @ B   D`o}`` {N t`M tF tN t`R`R` A Lc LcREqFM tF tEF Lg Dp}@pqC tM {D t`E t`f t`k t`pȱqC tpȱqR t`REFF t`q}l {RM tF tEqF AL { A DM {D t`E t`f t`k t`pȱqR t`Rr}M tF tEqF AL { AL { AK {j t` A @ BK {o t` A @ BK {` ,A s}A @ł Ńp t`k {q te @` > ,A AA @ȥ` ,A A @рȥр`J { A BI {t} > ȩȥ @`r tt tv t` A %r tt tq @ @ f` @t t`G { f` Av t` A u} %r tt tq @ @ f` @t t` @t t` f` A` A ,A @ +ȱ {DE {pȱqx t` Dv}Lf(/6ȱ%KF {s t t`u t t`w t`u tpȱqrȱs t t`sw} tpȱqrȱs t t`pȱq t`EFȱ {DE {pȱq x} t` t` geg t @`27@ gwg t @`38A gg t @`49B @ @ +> {  {`1 ty}`  { t` {` @ @ ' t 1 t: tq @` { Fh5 t` Fh6 z}t` ,A Aрт @` { sh; t` sh< t` ,A Aрт @` { A @  {= t`> t` A @{} {? t`sq @襀&0G&0Aee02&0,)ee0쉋пz{z{`b {q|} @|}~轉 i i쉋`轉 i쉋` j Vj` j .jep Vj`F { j .j8倍p Vj`F }}{| i) i`iPF {`8PF {`.....~.}.|`N|n}n~nnnnn`襀 ~}F { e )e쉋`d ɝF {8펍| |  iLj ΎLj`| } ~ } `| i iLjiPiiii~i~}i}|i|ح|) j i` > @ } A  >ȥ`ȱȱȱ A VAȥȥȥ @` )m}ȥ` )m` A m` n` )mȥ` n m`ȱȥ` ,A > ȥ @Ll Aȱȱ} Bo {z{ dEQ { >zȭ{ ȱȥȱ 7n`ȱ ȱ}ȱ A ȥȥȥ`ȱȱ Aŀȱ偰 ȥ ȥ}` > ?ȥȱȥLmȱ >e {ȱҠ}`ȱȱȥȥqȥqȱȠȥ` 1s Bn }{ȱȥ` A @ @ @ @ȱȱ#ȱł ŃR { 0E}Ġȱȥ A ,A AA VA kA`H @ @ @h qo  ȥL_o ȱȱȱ}ȱȱ >e {ȱLoȥ ,A AA VA` }= @ >ȑȥ} ,A` @ @ ȱȱ =ȱLo A ,A`p > { >ȥ}ȥ`forward A @ @ @ȱ*ȱȱ >"ȱLAp ,A AA VA kA`}ȱ ,A AA VA kA` ph {` @ @ > p +q p ,A AA`ȱ}ȱ >ȱLq`-q} p A ,A` A ,A`writeln @ @⅂s > p A ,A` A ,A`write @ @#}t > p A ,A` A ,A`readln @ @et > p A ,A` A ,A`read ȱ &} &`IJK @I t & t u & AIJK`&&iiuȱ`}ȱ &ο`G &pq Puν4, &rs Puν!, &tu Puν, &vw Pu`ݘuuLuݘu}uuuLju 0 &ץ 0 &` d'_ &pq Pu &`xxx$x)x.x3x8x=xBxHxNxSxXx}]xbxgxlxqxvxzx~xxxxxxxxxxxxxxxxxxxxxxxx}xxxyy yyyyy$y)y.y3y8y=yByGyLyQyVy[y`yeyjyoytyyy~yyy}yyyyyyyyyyyyyyyyyyyyyyyyzz zzzz!z&}z+z/z4z9z>zCzHzMzRzWz\zazfzkzpzuzzzzzzzzzzzzzzzzz}zzzzzzzzzzzz_lla_lga_lia_ldb_ldw_ldr_zld_min_max_ndxb_ndxw_ndx_chk_stb_s}tw_str_zst_mov_flt_eq_ne_lt_gt_le_ge_lti_gti_lei_gei_eqr_ner_ltr_gtr_ler_ger_eqs_nes_lts_gts_les_ge}s_eqm_nem_zeq_zne_zsb_zsp_zin_fln_adi_sbi_mpi_dvi_mod_adr_sbr_mpr_dvr_or _and_ngi_ngr_not_zun_zdf_zn}t_lcw_wri_wrr_wrf_end_lnk_lcrdb_jsr_jsx_out_wrl_lpa_lin_lsa_wrs_tdo_ddo_sgw_sgb_slw_slb_cgw_cgb_clw}_clb_igw_igb_ilw_ilb_dgw_dgb_dlw_dlb_jmp_wrc_fjp_beq_fld_wrx_wrb_err_go_lbl_zsg_zsr_zem_inp_rdc_rdf_}rdi_rdl_rdr_rdv_abi_abr_arc_cos_eof_eol_exp_ln_odd_prd_scc_rou_sin_sqi_sqr_sqt_tru_res_rew_equ_new_d}is_rds_get_put_pag_chn_wrv_wre_fun_see {L) <{ { { {` "{` "{` <{ { { {` %{{ %} z${ % %" % %`error on line  of include file "ɛ % %` %θ^ % %`}&ii{ȱ % %`G}b}w}}}}}}}}}~~"~1~>~O~\~m~~~~~~~~~~~~~~~~~~~~)?}Th} (9Gaoˀ *BXtρ7fvт4N_m܃ !@[q}τ$:PfɅ,JKhij̆ &'()Guڇ )*+,}-.semantic analyzer got losterror in simple typeidentifier expected"program" expected ")" expected ":" expectedillega}l symbolerror in parameter list "of" expected "(" expected error in type "[" expected "]" expected"end" expected ";" expect}edinteger expected "=" expected"begin" expectederror in declaration parterror in field list "." expected "*" expected "..}" expectedinclude file not foundrecord type requireddigit-sequence expectedinteger type requiredpointer type} requiredstring type requiredtoo many parametersmissing parameter(s)end of line expectedpathname requirednested include} dos error47 errorfile or textfile type requiredreal type requirederror in constant ":=" expected"then" expected"until"} expected "do" expected"to" or "downto" expected "if" expected"file" expectederror in factorerror in variablechar type r}equiredunexpected end of filepage 1 stack overflowstack overflow heap overflow!line too long or no cr before eof i/o error}must be integer or realthis array is too bigincompatible with file type#char, integer or real type requiredtextfile type }requiredrecord size exceeds 65535 bytesbase type must be ordinalmixed base typesordinal type required&field width paramet}ers must be integer.must be integer, real, char, boolean or stringnot a procedurenot a function not a setnot in tag type r}angeduplicate case constantcircular definitionnot a constant identifiervariable is not a pointererror in domain typefun}ction result undefinednot assignment compatiblecannot be formal must be localthis is not a variablenull string not allowe}d string cannot cross source linesforward declared as a functionforward declared as a procedurenot a constantordinal type} requiredinteger constant exceeds 32767expression must be booleannot a type identifieridentifier declared twicelow bound} exceeds high bound&identifier is not of appropriate classidentifier not declaredsign not allowednumber expectedincompati}ble subrange typesfile not allowed heretype must not be realordinal type required incompatible with tag field typeindex t}ype must not be real%index type must be scalar or subrangebase type must not be realbase type must be ordinal-error in type} of standard procedure parameterunsatisfied forward referencerepetition of parameter listrepetition of result typemiss}ing result type2this is neither a variable nor function identifierincorrect number of parameterstype conflict of operand}sillegal type of operand(s)type of variable is not array-index type is not compatible with declaration not a record}illegal type of expression type conflict*case-constant type differs from case-indexsubrange bounds must be scalar no }such fieldagain forward declaredundeclared labelÍ @` ,A$ { B >}ÍȥȥÍpq EW t` AÍ`Í4ȱ ȱL͈}``ȱȱ >ȱL`Í4ȱ ȱL͈J