LnSOS BOOT 1.1 SOS.KERNEL SOS KRNLI/O ERRORFILE 'SOS.KERNEL' NOT FOUND%INVALID KERNEL FILE: xةw,@  ȱlmi8#)!)SOS DRVR"STANDARD )((8*,;((*,((+)((9/(p((>3  =9 :9 .(+( 8#8# %3(8 ((,+)(%.4$)?((,(103 ?i +%SEG.T Rj Ÿ/ KERMIT.03.8564u' DISKNAME.DATL'Ҳ Ҳ*MENU.MAKER D } >*SOS.DRIVER $Ҳ6Ҳ6SOURCE.2Ҳ+Ҳ+,STARTUP.CODEUP(Ni;pSYSTEM.MISCINFO >dLԡm#i㰼m#iЕOLԡȱfg hi !dLԡ憦  Ljmkm l y`2 Lԡ8(Je稽)ʈ@L 7  3  5  >>< (&20 *, **>> "2*&" " >>  ">> "8""> """"""<  JژJMڰ Бڐ(`MЭ`,J8= ,0 8ݬ0#Е JґֱБԈ0נL`,MB ,0 8ݬ#Е JґֱБԈ0ԠL`_`Whh,MpM @M  L ð H zhhL`Jڱԑб֑ڐJԑФL8JґֱБԈ8LJ,MґЈ`MЭ҈`J`Kʎ`J`KLǍJ`L DLW`    LL,$ RTV,pP`Q``J`K ڭ)ڍ`J`K)ڭ)ڍ`J`KJnJnJnJn` + /x) `(, @L`J`K{IiLHT,0L 8L݌HmL hЕ ,K  L``@``,ʎL `, LL- LLL,L`)ߢ L`J`K)Jjj,p_xJJJ ***( STV`m8(8ڍ (HH` M O,$LP LJ)J`KJ (H'HJ`67p#/8HO:Pixy|NU@Vo` mmȌ P,0J`8mmL`UȭV`BbTtVvHhLlPpSs    UVU8° , P  (P LO(`HFxȘ)FH(`x  (,8`L  @., / p!  L^ML/,J0& I 0 LW,*,= kɠ) .LR ,"nPL&,Q0,U V L&LKJ,Ep*\   R­SíTUVL&U V , L7L&,P ©mUUVe…åJ,ͻL& /MNG H @"DC`, 0 C,L M QUVPGNG nQRÍST,)ĭ ,0# kO,0 ,0, ,P) +I OUV ,0O OLHO Oh,ȥ©L],Pݶ PL& L& ,#+0    @H?H` (W 99nP) Ì `,C$ ( % ( = x) (,DL8H\0`(d  $,($  ,' Copyright 1982 Quark Incorporated,.CONSOLE a#COPYRIGHT 1982 QUARK ENGINEERING P0,>!SHOLES 1!1!2@23#3#4$4$5%5%6^67&7&8*8*9(9(0)0)-_-=+=+\|QWERTYUI OP[{]}`~`~ASDFGHJ K L ;:;:'"'"ZXCVBNM ,<,<.>.>/?/?d0hp00000>" <"<"""<< <"""<"><$""< """"  "" 6***""""""""""<""< :< $"""2,"""""**6"""""< >>8  8>> ""*:<"">""""""""""""">>><2"<""">""" ""  ">"6**"""""&*2""""""""""""*,"" "" ">""""""""""""""**6"""""""> >>> L` ,MH0 M0` 0  g   H H`! (+ , E Q W ] { i c c c c c c `0" (0èÈ`ȭ``G`H``O,0 kI`0+ڽڐ`ȭ`O,0 kɠ)`,I08ȭéL `0  g  ސ  H H`! (< i < + + @"`JIG L`0" ( @0Ù /L`)ȱÍ`)`=`Ɂ" (EŅ|o,i0prH 8fofo7,T0*,V-x ) V)(LU Kh,RSL@pȥȑ`,Q0LmEąĩEŅ Km`l KL 8fol,Q0L H HH` (# ( (Q`,Q$ ()PJK % "]RSiTU Q`% (QLl Xx )(JK `,Q0LpEąĩuter Inc. 1983L'-036=ADGMPVaflorw258  $I(C) Apple Computer 1981, 1982, 1983. Built-in Serial Port RS-232 Driver._r.RS232 c &߄P(C) Apple Comp e k n s             ! # % ' ) + - / 1 3 5 7 9 ; > C F L R W Z _ b h t {       5 H M ] n      * !$.3>BEJNTX[`ehmqtw{~  * . 3 ; > A D O S a e }            " $ & ( * > G M S Y _!#%')+-/135;>EHKNQTX[^chnsvy| "%(-GLP^nx %BGJSWcfiorw|7<GJQX]behlos"'/258;@CFILS`ci 14OVY\jmv   *ޮ,M0  FAEFHHH hh&G!HGEHȘ)E`@` $(?ACEGIKMOWZ]kp|"'*-2ЭJeЅЅ(хI `mЅ`,C`#L(0`I<,)ɄM൐IະED@ I` III`)I@` HFE`I`01)) I@) @J) )) (j݈)݉;`i @iÐĭ,0 8ݭH iJieÅťiƥJ$0ґűБÈ0 őұÑЈ8e݅åih kO,ILO` ,0`O, HJh `Э` , J``mHJ) I h)i ,   x) `(`%L(,   LX     ; )D  JJ*  I `x|x|,,P,`ɏ Iª`,I0M0iȱi0`" (GxHEF(`ÍD` 0+xÝڐ(`W_`,M LW @Lo֌ ׍ Ñ `^ [i  ȢֱÍ 8eÅÐĩ׭ & &ׅ֠Ñֈ  ڠũ LL `" (, 0HGH`! (NOo}`\" (x\ÈȌk(`RȭS` l  o `ȩ`,Q0L HH`LB<Xf,T U K,U0x])] olXYmnpqVWZ[kj^)  ]] ^ ) (`\" ( Ù\ `ÍRȱÍS`l031e-Yx V(Y K`j) )g kkL)` kkLl ),b-cWLldWuoeQ,T0L@TEPd>gZ[M,h,oe$YHV ; ; macro Pop : pop a word from the evaluation stack ; (.macro Pop (pla (sta %1 (pla (sta %1+1 (.endm ( ; ; macro Push : push word on to evaluation stack ; (.macro Push (lda %1+1 (pha (lda %1 (pha (.endm ( ; ; macro SOS :  !"#$%&@ @@ # ## :M)O^ƣ<Ҳ9p4$NOTENҲ#Ҳ#SOURCE.2vҲ+' ',MACHLIB.CODE?Ҳܢ,MACHLIB.TEXT8Ҳ8ܢ,UCKERM2.TEXTm1`Ҳp-+UCPARS.TEXT(,Ҳp+UCRCVS.TEXT4Ҳ8ܢ+UCSNDS.TEXT$.BPV^dhx %(-5QY\adgjmruz  #NS) `x,V0 %)(`JN{"'*INYox{  %*/:>GIKMUclsy  ))ho kk0 qroqYLJ,h,VLJj)`X5L8,jL%,TP TcL,UUTdLXXL%lk,W0f,bPZ,[0W[cLZnoln _L" `L" aX ) ` do an SOS call ; (.macro SOS (brk (.byte %1 (.word %2 (.endm ( Ret .equ 00 Size .equ 02 Psudo .equ 0E0 Maxaddr .equ 04 Inpadd .equ 0E4 Base .equ 0E2 Blanks .equ 06 ; ; Rcvinit : initialize the RS232 port ; Called from PASCAL as RCVINIT(Q,SIZE); ; (.proc Rcvinit,2 (.def RRef ( (Pop Ret ; Save return address (Pop Size ; Save length of q (Pop Psudo ; Get address of q (SOS 0C8,RSlO^% ; Save the size argument (Pop Psudo ; Load up pseudo-registers (SOS 0C8,CNlst ; Open Console (ldy #09 ; Point to end of q header (lda #00 ; Close request arg list Ref .byte 00 ; ; Kbdinit : initialize keyboard ; Called from PASCAL as KBDINIT(Q,SIZE); ; (.proc Kbdinit,2 (.def CRef ( (Pop Ret ; Save the return address (Pop Size ; Save the return address (lda RRef (sta Ref ; Install ref no in arg list (SOS 0CC,CL_LST ; Do a CLOSE call (Push Ret (rts ; Return ( CL_LST .byte 01 (.byte 0F ; Length of status list Buf .block 0F ; Status list buffer ( ; ; Rcvfinit : close RS232 ; Called from PASCAL as RCVFINIT; ; (.proc Rcvfinit,0 (.ref Rref ( (Pop Ret ; Number of arguments =3 (.byte 00 ; Device number of RS232 (.byte 01 ; Stat code = control paramters (.word *+2 ; Status list pointer GET_DEV_NUM req (.word RS232 ; Pointer to device ID Devnum .byte 00 ; Device number returned here ( RS232 .byte 06 ; RS232 device ID (.ascii ".RS232" DClst .byte 03 ter (.byte 01 ; One element in option list Opt .byte 03 ; Open for R/W access RRef .byte 00 ; Storage for RS232 ref no.   Dev_lst .byte 02 ; 2 args for  RSlst .byte 04 ; Four arguments for OPEN (.word RS232 ; Pointer to device ID block Ref .byte 00 ; Reference number returned here (.word Opt ; Option list poinf,y ; 8-bits, no parity on RS232 (Sos 083,DClst ; Install these changes (Push Ret ; Recover the return address (rts ; Return ; Request RS232 parameters (ldy #0C ; Point to Imm Read byte in buf (lda #80 (sta Buf,y ; No-wait I/O to RS232 (ldy #01 ; Point to Data Format byte (lda #00 (sta Bue q (dey (lda Size (sta (Psudo),y ( (SOS 084,Dev_lst ; Fetch the SOS device number (lda Devnum ; and save it (sta DClst+1 ; Save device number in arg blk (SOS 082,DClst (lda Ref ; Save the SOS reference number (sta RRef ; in RRef and in q (sta (Psudo),y (dey (lda Size+1 ; Save array size in the first (sta (Psudo),y ; word in thst ; Open RS232 port (ldy #09 ; Point to end of header (lda #00 $1 sta (Psudo),y ; Zero INP, OUTP, MAXCHAR, REF (dey (cpy #02 ; Stop at third byte (bne $1 ')*+,-./0123456789:;<= statustype; done: boolean; matches: integer; begin eat_spaces(line); if length(line) = 0 then getsym := ateol else begin stat := null; done := false; isolate_word(line,s); i := allsym; et_on_off, get_char, get_show_parm, get_help_show, get_help_parm, exitstate); var status: statustype; word: vocab; state: states; function get_sym(var word: vocab): statustype; var i: vocab; s: string; stat: if length(s) <> 1 then getch := false else begin ch := s[1]; get_ch := true end (* else *) end; (* getch *) function parse(*: statustype*); type states = (start, fin, get_filename, get_set_parm, get_parity, gteger; begin get_fn := true; isolate_word(line, fn); l := length(fn); if (l < 1) then get_fn := false end; (* get_fn *) function getch(var ch: char): boolean; var s: string; begin isolate_word(line,s); done := true else s := concat(s,copy(line,i,1)); i := i + 1; end; (* while *) line := copy(line,i,length(line)-i+1); end; (* isolate_word *) function get_fn(var line, fn: string): boolean; var i, l: in end; (* eatspaces *) procedure isolate_word(var line, s: string); var i: integer; done: boolean; begin done := false; i := 1; s := copy(' ',0,0); while (i <= length(line)) and not done do begin if line[i] = ' ' then while not done do begin if s[1] = ' ' then begin i := length(s) - 1; s := copy(s,2,i); done := length(s) = 0 end (* if *) else done := true end (* while *) := 1 to length(s) do if s[i] in ['a'..'z'] then s[i] := chr(ord(s[i]) - ord('a') + ord('A')) end; (* uppercase *) procedure eatspaces(var s: string); var done: boolean; i: integer; begin done := (length(s) = 0); filename, line: string; newescchar: char; expected: set of vocab; procedure uppercase(var s: string); function parse: statustype; procedure initvocab; IMPLEMENTATION procedure uppercase(*var s: string*); var i: integer; begin for iym,helpsym, ibmsym, localsym, marksym, nonesym, oddsym, offsym, onsym, paritysym, quitsym, recsym, sendsym, setsym, showsym, spacesym); var noun, verb, adj: vocab; status: statustype; vocablist: array[vocab] of string; (*$S+*) unit parser; INTERFACE type statustype = (null, at_eol, unconfirmed, parm_expected, ambiguous, unrec, fn_expected, ch_expected); vocab = (nullsym, allsym, consym, debugsym, escsym, evensym, exitsym, filewarns matches := 0; repeat if (pos(s,vocablist[i]) = 1) and (i in expected) then begin matches := matches + 1; word := i end else if (s[1] < vocablist[i,1]) then done := true; if (i = spacesym) then done := true else i := succ(i) until (matches > 1) or done; if matches > 1 then stat := ambiguous else if (matc status := parm_expected else if (status <> unrec) and (status <> ambiguous) then state := fin end; (* get_on_off *) get_char: if getch(newescchar) then biguous) then state := fin end; (* case get_parity *) get_on_off: begin expected := [onsym, offsym]; status := getsym(adj); if status = ateol then expected := [marksym, spacesym, nonesym, evensym, oddsym]; status := getsym(adj); if status = ateol then status := parm_expected else if (status <> unrec) and (status <> am getonoff; filewarnsym: state := getonoff; end (* case *) end; (* case get_set_parm *) get_parity: begin e noun of paritysym: state := get_parity; localsym: state := get_on_off; ibmsym: state := get_on_off; escsym: state := getchar; debugsym: state := debugsym, filewarnsym]; status := getsym(noun); if status = ateol then status := parm_expected else if (status <> unrec) and (status <> ambiguous) then cas end (* if *) else status := fnexpected end; (* case get file name *) get_set_parm: begin expected := [paritysym, localsym, ibmsym, escsym, end; (* case fin *) getfilename: begin expected := []; if getfn(line,filename) then begin status := null; state := fin status := getsym(verb); if status = ateol then begin parse := null; exit(parse) end (* if status *) else status := unconfirmed setsym: state := get_set_parm; showsym: state := get_show_parm; end (* case *) end; (* case start *) fin: begin expected := []; consym: state := fin; exitsym, quitsym: state := fin; helpsym: state := get_help_parm; recsym: state := fin; sendsym: state := getfilename; begin parse := null; exit(parse) end (* if *) else if (status <> unrec) and (status <> ambiguous) then case verb of ase state of start: begin expected := [consym, exitsym, helpsym, quitsym, recsym, sendsym, setsym, showsym]; status := getsym(verb); if status = ateol thenhes = 0) then stat := unrec; getsym := stat end (* else *) end; (* getsym *) begin state := start; parse := null; noun := nullsym; verb := nullsym; adj := nullsym; uppercase(line); repeat c state := fin else status := ch_expected; get_show_parm: begin expected := [allsym, paritysym, localsym, ibmsym, escsym, debugsym, filewarnsym]; status := getsym(noun); if status = ateol then status := parm_expected else if (status <> unrec) and (status <> ambiguous) then state := fin end; (* case>@ABGA3/1.0 RCVINIT := 'SHOW'; vocablist[spacesym] := 'SPACE'; end; (* initvocab *) end. (* end of unit *) vocablist[offsym] := 'OFF'; vocablist[onsym] := 'ON'; vocablist[paritysym] := 'PARITY'; vocablist[quitsym] := 'QUIT'; vocablist[recsym] := 'RECEIVE'; vocablist[sendsym] := 'SEND'; vocablist[setsym] := 'SET'; vocablist[showsym] vocablist[filewarnsym] := 'FILE-WARNING'; vocablist[helpsym] := 'HELP'; vocablist[ibmsym] := 'IBM'; vocablist[localsym] := 'LOCAL-ECHO'; vocablist[marksym] := 'MARK'; vocablist[nonesym] := 'NONE'; vocablist[oddsym] := 'ODD'; itvocab; var i: integer; begin vocablist[allsym] := 'ALL'; vocablist[consym] := 'CONNECT'; vocablist[debugsym] := 'DEBUG'; vocablist[escsym] := 'ESCAPE'; vocablist[evensym] := 'EVEN'; vocablist[exitsym] := 'EXIT'; psym: state := fin; exitsym, quitsym: state := fin; end (* case *) end; (* case get_help_show *) end (* case *) until (status <> null); parse := status end; (* parse *) procedure in consym: state := fin; sendsym: state := fin; recsym: state := fin; setsym: state := get_help_show; showsym: state := fin; hel if status = ateol then begin parse := null; exit(parse) end; if (status <> unrec) and (status <> ambiguous) then case noun of t_help_show *) get_help_parm: begin expected := [consym, exitsym, helpsym, quitsym, recsym, sendsym, setsym, showsym]; status := getsym(noun); then begin status := null; state := fin end else if (status <> unrec) and (status <> ambiguous) then state := fin end; (* case ge get_show_parm *) get_help_show: begin expected := [paritysym, localsym, ibmsym, escsym, debugsym, filewarnsym]; status := getsym(adj); if (status = at_eol) hhhhhhZ ]bcfon ttnHH`gag.RS232srfeWVUSNIG?>:/hhHH`(hhhhhh` cq1600 =Q:WW=0A=:A=21A=9&oldprefix$=40A=31410: Control C "aborts" program to Basic(:A=13770: Return Selects a file *DA=27:50: Escape to change disks/FA=324000: back out one directory level 3GA=(80+UCA)A=(80+L"BASIC 0":150A$="TEXT 0":150A$="CAT 0":150A$="FONT 0":150A$="FOTO 0":150A$(L),"BLOCKS")510*=27:=19:"FREE MEMORY AVAILABLE: ";=7:=20:"80C";A$(L);$:=5:THPOS=4:I=1:IBOTM=J-1:620Q=:=26:=21:sic; +Q Quits."r12);::"80C";a$;:+w#9,"DISKNAME.DAT":#9;DISKNAME$:#9|d$=DISKNAME$$=23:=0::"80C";d$;::12)201M=3:=14:"This /// SIG Disk is \^ 19";Р,2)", Washington Apple `, Ltd."=4:B$(1)="":B$(2)=""A$=16,B) THEN 240 #1, d$="":=10:"80C";d$ ž#1300I=0"I=I+1:#1;A$(I):290,#1 6L=I-1@j=1:same=0 J:SEG=0 Tœ2030^CT<1CT=1cCT>13000Zha$="{,|,~,}; selects; to new disk; J/2)=4:=+1:ۙ=44B$(J);:J=J+1I:1,180,22:2,280,21:2,2380,23:8A$(1000),B$(1000),C%(511),C$(20),name$(20):=10:=0UCA=128:LCA=UCA+32CT=15 IF PREFIX$= PREFIX$+MID$(B$(I),CEFGHIJKPVOLUME NAME (/DISKNAME) OR DEVICE NAME (.Dx)"P12);::"80C";a$;:Zb$="CHANGING DISKS"$d=23:=0::"80C";b$;::12).n=12:=20:"MAKE A NEW MENU FOR DISK: ";N$xN$)<2110=N$ :210 I=1L(A$(I),A$))200B$0 WAP /// SIG MENU.MAKER PROGRAM (v. 6.2) =".D1"210: Coldstart (320: Warmstart &*X=11000: TEXT SLOW-DOWN LOOP ,X.1 CHANGE DISK SUBROUTINE23œ202:2200<RFa$=" YOU MAY SELECT YOUR DISK BY FETCH FETCH CREF EF  RCVINIT RCVINIT RREF bRCVFINIT RCVFINITRREF EF KBDINIT KBDINIT CREF qKBDFINIT KBDFINITCREF EF SENDBRK SENDBRK HH`fa_^[# B 80eȱe0LL eeeȱeeȱe۠8ȥ8eȱe 00 ˝ruw x{v{ xvHH`hg.CONSOLEh{j^]ONMJGEB?=54'#hhHH`(hh'&HH`.RS232+&%$"@hhhhCA)"PRINT.ALL": OA+P 3HA=(81+UCA)A=(81+LCA):::: OA+Q Quits 3IA=(83+LCA)A=(83+UCA)"PRINT.SHOW": OA+S 2JA=(68+LCA)A=(68+UCA)/Screen.Savers/HELLON=THPOS:B$(I);XA<8A>11540bA-7640,660,690,720l:=THPOS:B$(I);v:520: 500THPOS=4:I/2=I/2)I=I-1I=IBOTM THPOS=44:I/2<>I/2)I=I+1I2=-1:I=I-2:IBOTM<30THPOS=44I=IBOTM/2)*2:=+IBOTM/2)-1:=== ============ MACHLIB.CODE 5 28-Jun-81 MACHLIB.TEXT 29 28-Jun-81 UCKERM2.TEXT 49 16-Mar-85 UCPARS.TEXT 23 16-Mar-85 UCRCVS.TEXT 27 28-Jun-81 UCSNDS.TEXT 31 16-Mar-85 MOTE CREATED ============ ====== ============ PARSELIB.CODE 9 22-Apr-84 UCAPPL.TEXT 5 22-Apr-84 UCHELP.TEXT 15 11-Sep-81 UCKERM.TEXT 41 16-Mar-85 AND IN SOURCE.2: NAME BLOCKS DATE CREATED ============ === NOTE: THE FILES IN SOURCE.1 AND SOURCE.2 ARE PASCAL TEXT OR CODE FILES AND ARE *NOT* READABLE FROM BASIC. BUT YOU *CAN* READ THEM WITH PASCAL MENU.MAKER, DISK 1054 OR THE PASCAL DEVELOPMENT SYSTEM. THE FILES IN SOURCE.1 ARE: NAME BLOCKS DAKERMIT /// TELECOMMUNICATIONS PROGRAM el; G$:::320H: Error Routine 202:U=11:"79C";"BAD PATH ERROR (NO DISK IN DISK DRIVE OR DESIRED FILE NOT FOUND.)"X=11000:X:::210Z a$="{,|,~,}; selects; back 1 lev 1600 &:WW=1:0 :SEG=1;".D1/S EG.F" SEG=1".D1/SEG.G"diskname$=3802  CATCH PASCAL TEXT FILES 202 :F*=08:"78C";"SORRY BUT MENU.MAKER CAN'T READ PASCAL TEXT FILES."04=10:"M$="NOVEMBER":1750M$="DECEMBER":1750826);"-";M$;" ";Ѡ,2));", ";"19";Р,2);" ";/П,2))=>13П,2))-12;џ,6);:1780$П,2))=0"12";џ,6);:ٟ;$П,2))=>12" PM-":" AM-" 1830WW=1530 =26:=211660,1670,1680,1690,1700,1710,1720,1730,1740^M$="JANUARY":1750hM$="FEBRUARY":1750rM$="MARCH":1750|M$="APRIL":1750M$="MAY":1750M$="JUNE":1750M$="JULY":1750M$="AUGUST":1750M$="SEPTEMBER":1750M$="OCTOBER":1750T 0")2070H540R\A$="RUNNING "+B$(I),16,B)f"79C";A$;:=0pB$(I),16,B) z::SEG=1".D1/SEG.T"t=+B$(I),16,B) yCT=CT+1~240:=24:=0:"@ ..... "DATE.TIME.LINE" ....JM=Ҡ,4,2))BTM1630,1640,1650,0=+IBOTM/2-.5):I=IBOTM:I/2=I/2)I=I-1 œ2120B=B$(I),16)," ")-1 B$(I),"BASIC 0")850B$(I),"TEXT 0")890 B$(I),"CAT 0")1140*B$(I),"FONT 0")18504B$(I),"FOTO 0")1930>B$(I),"PASTXa$,1)="/"5060:s=s-1 5030=a$240 MENU.MAKER 6.2 * Thanks to C.M.Davidson for his help!EAD PASCAL TEXT FILES."04=10:"78C";"ANY KEY RETURNS TO THE MENU."!>G$:::".D1/MENU.MAKER",320R",220(204::"79A";""; 2D=1:F=1 <#4;a$ FD=D+1 P#5;a$ZD=60#5;12)dD=60D=1nF=F+1::d$;::Y=1100:Y x13402  CATCH PASCAL TEXT FILES 202 :F*=08:"78C";"SORRY BUT MENU.MAKER CAN'T R".D1/MENU.MAKER",220 d$="" A$="PRINTING "+B$(I),16,B)=01:=0::"80C";A$;:#3,B$(I),16,B)Z=1#3;b$:"78A";b$Z=Z+1:Z=18:1290 1260 #4,B$(I),16,B)#5,".PRINTER"+ž#4#5;12):::".D1/MENU.MAKE30C$="N"C$="n"1160;:=23:=0::"79C";"PRESS ANY KEY TO HALT LISTING": $1020.202 8::Z=1B::=23:=0::"79C";"WOULD YOU LIKE A PRINTED COPY?":1C$:C$<>"Y"C$<>"y"C$<>"N"C$<>"n"1170*C$="N"C$="n"QST79C";"PRESS ANY KEY TO HALT LISTING"::202 1020#2,B$(I),16,B)ž#242:::1160Z=1#2;A$:"78A";A$Z=Z+1:Z>1842:::Z=1980*:=23:=0::"79C";"CONTINUE...?":1C$:C$<>"Y"C$<>"y"C$<>"N"C$<>"n"10 MENU.MAKER TEXT MODULESEG=0"MENU.MAKER"890&*X=11000: TEXT SLOW-DOWN LOOP ,X.1,180,22:2,280,21:2,2380,23:z:A$="LISTING "+B$(I),16,B)$=01:=0::"80C";A$;::12)>=23:=0::"{UCKERM2: Second half of UCSD KERMIT source code } { } { Modified 03-16-85 AMB: The "spack" procedure blows on text } { llnopqrstuvwxyz{|}~O^Wines that are too long. Truncate them } { and let the user know about it. } { }  procedure spar(*var packet: packettype*); (* fills data array with my send-init parameters *) begin packet[0] := tochar(chr(maxpack)); (* biggest packet i can receive *) packet[1] := tochar(chr(mytime)); (* when i want to be timed out *) packet[2] := tochar(chr(mypad)); (* how much padd buffer[bufp] := tochar(chr(len + 3)); (* character count *) bufp := bufp + 1; chksum := chr(ord(chksum) + ord(tochar(chr(num)))); buffer[bufp] := tochar(chr(num)); bufp := bufp + 1; chksum := chr(ord(chksum) + ord(ptype)); buunitwrite(oport,padchar,1,,12); (* write out any padding chars *) buffer[bufp] := chr(soh); (* packet sync character *) bufp := bufp + 1; chksum := tochar(chr(len + 3)); (* init chksum *) gotoxy (0, debugline + 5); *write ('Trunc = "', trunc_str, '"'); *for i := 0 to 5 do begin .gotoxy (0, debugline + i); .write (chr (30)); *end; *gotoxy (0, debugline); *end; '{endif} 'end; ${endif} $bufp := 0; for i := 1 to pad do > ' ' then trunc_val := true; 'end; 'len := max_xfer + 1; 'if trunc_val then begin *gotoxy (0, debugline); *write ('ERROR: The following line is truncated at ', max_xfer); *gotoxy (0, debugline + 2); *for i := 1 to max_xfer do write (data [i]); *$if (max_xfer > (max_pack - 6)) then begin 'max_xfer := max_pack - 6; 'trunc_val := false; 'trunc_str := ''; 'for i := (max_xfer+1) to (len-1) do begin +trunc_str := concat (trunc_str, ' '); +trunc_str [length (trunc_str)] := data [i]; +if data [i] then (* if wait too long then *) begin exit(spack) (* get out *) end; (* if *) end; (* if *) $max_xfer := len - 1; {03-16-85} := 0; repeat (* wait for an xon *) repeat count := count + 1 until (readch(rq,ch)) or (count > maxtry ); until (ch = xon) or (count > maxtry); if count > maxtrypackettype; ch: char; $max_xfer: integer; {03-16-85} $trunc_str: string; $trunc_val: boolean; $ begin if ibm and (state <> 's') then (* if ibm and not SINIT then *) begin count for i := 1 to 2000 do ; end; (* packetwrite *) procedure spack(*ptype: char; num: integer; len: integer; data: packettype*); (* send a packet *) const maxtry = 10000; var bufp, i, count: integer; chksum: char; buffer: begin gotoxy(0,debugline); for i := 0 to len+3 do begin if i = 80 then begin gotoxy(0,debugline+1); unitwrite(1,erase,1,,12); end; (* if *) write(p[i]) end; (* for *) har i must send *) quote := packet[5]; (* incoming data quote char *) end; (* rpar *) procedure packetwrite(p: packettype; len: integer); (* writes out all of a packet for debugging purposes *) var i: integer; timint := ord(unchar(packet[1])); (* when i should time out *) pad := ord(unchar(packet[2])); (* number of pads to send *) padchar := ctl(packet[3]); (* padding char to send *) eol := unchar(packet[4]); (* eol c packet[6] := 'N'; (* I won't do 8-bit quoting *) end; (* spar *) procedure rpar(*var packet: packettype*); (* gets their init params *) begin spsiz := ord(unchar(packet[0])); (* max send packet size *) ing i need *) packet[3] := ctl(chr(mypchar)); (* padding char i want *) packet[4] := tochar(chr(myeol)); (* end of line character i want *) packet[5] := myquote; (* control-quote char i want *) ffer[bufp] := ptype; (* packet type *) bufp := bufp + 1; $ for i := 0 to len - 1 do (* loop through data chars *) begin buffer[bufp] := data[i]; (* store char *) bufp := bufp + 1; chksum := chr(ord(chksum) + ord(data[i])) end; (* for i *) (* compute final chksum *) chksum := chr(aand(ord(chksum) + (aand(ord(chksum),192) div 64), 63)); buffer[bufp] := tochar(chksum);var count, i, ichksum: integer; chksum, ptype: char; r: char_int_rec; begin count := 0; if not getsoh(rq) and (state<>'r') then (*if don't get synch char then *) begin rpack := 'N'; (* trea* turn on goto option...need it for next routine *) function rpack(*var len, num: integer; var data: packettype): char*); (* read a packet *) label 1; (* used to emulate C's CONTINUE statement *) const maxtry = 10000; ize1; (* increment pointer *) ch := chr(aand(ord(ch),127)); (* strip parity of char *) until (ch = chr(SOH)) (* if not SOH, get more *) end (* with q *) end; (* getsoh *) (*$G+*) ( if (count > maxtry) then begin get_soh := false; exit(get_soh) end; (* if *) ch := data[outp]; (* get the character *) outp := (outp + 1) mod qs begin count := 0; get_soh := true; fetch(q); $with q do begin repeat repeat count := count + 1; fetch(q); ,until (inp <> outp) or (count > maxtry); (* wait for a character *) end; (* getch *) function getsoh(*var q: queue): boolean*); (* reads characters until it finds an SOH; returns false if has to read more *) (* than maxtry chars *) const maxtry = 10000; var ch: char; count: integer; outp := (outp + 1) mod qsize1; (* increment pointer *) r.i := aand(r.i,127); (* strip parity from char *) getch := (r.ch <> chr(soh)); (* return true if not SOH *) end (* with *)it for a character *) if (count > maxtry) then (* if wait too long then *) exit(getch); (* get out of here *) r.ch := data[outp]; (* get the character *) const maxtry = 10000; var count: integer; begin count := 0; getch := false; fetch(q); $with q do begin repeat count := count + 1; fetch(q); (until (inp <> outp) or (count > maxtry); (* waad_ch *) function getch(*var r: char_int_rec; var q: queue): boolean*); (* gets a character, strips parity, returns true if it got a char which *) (* isn't Kermit SOH, false if it gets SOH or nothing after maxtry *) ffer pointer *) read_ch := true; (* and return true *) end (* if *) else (* otherwise *) read_ch := false; (* return false *) end (* with *) end; (* ree *) begin fetch(q); $with q do begin if (inp <> outp) then (* if a char there *) begin ch := data[outp]; (* get the char *) outp := (outp + 1) mod qsize1; (* increment bu unitwrite(oport,buffer[0],bufp+1,,12); (* send the packet out *) if debug then packetwrite(buffer,len); end; (* spack *) function read_ch(*var q: queue; var ch: char): boolean*); (* read a character from an input queu bufp := bufp + 1; buffer[bufp] := eol; if (parity <> nopar) then for i := 0 to bufp do (* set correct parity on buffer *) buffer[i] := parity_array[buffer[i]]; t as a NAK *) num := n mod 64; exit(rpack) (* and get out of here *) end; 1: count := count + 1; if (count>maxtry)and(state<>'r') then (* if we've tried too many times *) begin (* and aren't waiting for init *) rpack := 'N'; (* treat as NAK *) exit(rpack) (* and get out of here *) end; (* if *) if not getch(r,rq) then 'C': close := true; (* C: end connection *) 'S': begin (* S: show status *) noun := allsym; showparms end; (* S *) '?': begin (* ?: show options typed something in *) if (ch in ['a'..'z']) then (* uppercase it *) ch := chr(ord(ch) - ord('a') + ord('A')); if ch in ['B','C','S','?'] then case ch of 'B': sendbrk; (* B: send a break to the IBM *) nnect to remote host (terminal emulation *) var ch: char; close: boolean; procedure read_esc; (* read charcter after esc char and interpret it *) begin repeat until read_ch(kq,ch); (* wait until they've 1; *requestcode.stat_or_ctrl := 0; *requestcode.reserved := 0; *unitstatus (unitnumber, statuslist, requestcode); *requestcode.stat_or_ctrl := 1; *unitstatus (unitnumber, statuslist, requestcode); end; {SET_RS232} procedure connect; (* co8max_buf: 0..255; 8min_buf: 0..255; 8db_len: 0..255; 8handshake: 0..255; 8im_read: 0..255; 8i_status: 0..255; 8l_status: 0..255; 8end; begin *unitnumber := 8; *requestcode.channel := 0; *requestcode.request_num :=ist: packed record 8bufsize: 0..255; 8baud_rate: 0..255; 8data_format: 0..255; 8cr_delay: 0..255; 8lf_delay: 0..255; 8ff_delay: 0..255; 8protocol: 0..255; 8cc_1: 0..255; 8cc_2: 0..255; *) (*$G-*) (* turn off goto option...don't need it anymore *) procedure SET_RS232; var *requestcode: packed record 8channel: 0..1; 8stat_or_ctrl: 0..1; 8request_num: 0..255; 8reserved: 0..63; 8end; *unitnumber: integer; *statusl (* else *) rpack := ptype; (* return packet type *) if debug then begin gotoxy(0,debugline); write(len,num,ptype); for i := 1 to 1000 do ; end; (* if *) end; (* rpack chksum := chr(aand(ichksum + (aand(ichksum,192) div 64), 63)); if (chksum <> unchar(r.ch)) then (* if checksum bad *) rpack := chr(0) (* return 'false' indicator *) else (* mark end of data *) if not getch(r,rq) then (* get a char and *) goto 1; (* resynch if soh *) (* compute final checksum *) ) begin if not getch(r,rq) then (* get a char and *) goto 1; (* resynch if soh *) ichksum := ichksum + r.i; data[i] := r.ch; end; (* for i *) data[len] := chr(0); (* get a char and *) goto 1; (* resynch if soh *) ichksum := ichksum + r.i; ptype := r.ch; (* packet type *) for i := 0 to len-1 do (* get any data * if not getch(r,rq) then (* get a char and *) goto 1; (* resynch if soh *) ichksum := ichksum + r.i; num := ord(unchar(r.ch)); (* packet number *) if not getch(r,rq) then (* get a char and *) goto 1; (* resynch if soh *) ichksum := r.i; (* start checksum *) len := ord(unchar(r.ch)) - 3; (* character count *) *) writeln('B Send a BREAK signal.'); write('C Close Connection, return to '); writeln('KERMIT-UCSD command level.'); writeln('S Show Status of connection'); writeln('? Print this list'); write('^',esc_char,' send the escape '); writeln('character itself to the'); writeln(' remote host.') end; (* ? *) end (* case *) for ch := minch to maxch do (* stick a 1 on all chars *) parity_array[ch] := chr(aor(ord(ch),128)); spacepar: for ch := minch to maxch do (* mask off parity on all chars *) parity_array[ch] := c *) parity_array[ch] := chr(aand(ord(ch),127)) else parity_array[ch] := chr(aor(ord(ch),128)) end; (* for ch *) end; (* case odd *) markpar: *) begin if odd(shifter) then counter := counter + 1; shifter := shifter div 2 end; (* for i *) if odd(counter) then (* stick a 1 on if necessarymaxch do begin r.ch := ch; (* put char into variant record *) shifter := aand(r.i,255); (* mask off parity bit *) counter := 0; for i := 1 to 7 do (* count the 1's parity_array[ch] := chr(aor(ord(ch),128)) else parity_array[ch] := chr(aand(ord(ch),127)) end; (* for ch *) end; (* case even *) oddpar: begin for ch := minch to gin if odd(shifter) then counter := counter + 1; shifter := shifter div 2 end; (* for i *) if odd(counter) then (* stick a 1 on if necessary *) begin r.ch := ch; (* put char into variant record *) shifter := aand(r.i,255); (* mask off parity bit *) counter := 0; for i := 1 to 7 do (* count the 1's *) be max = 126; var i, shifter, counter: integer; minch, maxch, ch: char; r: char_int_rec; begin minch := chr(min); maxch := chr(max); case parity of evenpar: begin for ch := minch to maxch do until close; (* if still connected, get more *) writeln('Disconnected') end; (* connect *) procedure fill_parity_array; (* parity value table for even parity...not(entry) = odd parity *) const min = 0; echo(ch); unitwrite(oport,ch,1,,12) (* send it out the port *) end (* if *) else (* ch = esc_char *) (* else is ESC-char so *) read_esc; (* interpret next char *) *) if read_ch(kq,ch) then (* if char from keyboard then *) if ch <> esc_char then (* if not ESC-char then *) begin if half_duplex then (* echo it if half-duplex *) (* empty remote input buffer *) writeln('Connecting to host...type CTRL-',ctl(esc_char),' C to exit'); close := false; repeat if read_ch(rq,ch) then (* if char from host then *) echo(ch); (* echo it else (* anything else: ignore *) write(chr(bell)) end; (* read_esc *) begin (* connect *) $set_rs232; $clear_buf(kq); (* empty keyboard buffer *) clear_buf(rq); else if ch = esc_char then (* ESC-char: send it out *) begin if half_duplex then begin echo(ch); unitwrite(oport,ch,1,,12) end (* if *) end (* else if *) hr(aand(ord(ch),127)); nopar: for ch := minch to maxch do (* don't mess w/parity bit at all *) parity_array[ch] := ch; end; (* case *) end; (* fill_parity_array *) procedure write_bool(s: string; b: boolean); (* writes message & 'on' if b, 'off' if not b *) begin write(s); case b of true: writeln('on'); false: writeln('off'); end; (* case *) end; (* write_bool *) procedure show_parms; (* shows the various setta parity := nopar; initvocab; fill_parity_array; ibm := false; xon := chr(17); bufpos := 1; bufend := 0; rcvinit(rq,rqsize); kbdinit(kq,rqsize); $erase:=erase_eol; end; (* initialize *) procedure closeup; har := chr(my_esc); quote := my_quote; ctlset := [chr(1)..chr(31),chr(del),quote]; half_duplex := true; {changed default to true 03-16-85} debug := false; fwarn := false; spsiz := max_pack; rpsiz := max_pack; n := 0; case *) fill_parity_array; end; (* paritysym *) end; (* case *) end; (* set_parms *) procedure initialize; var ch: char; begin $pad := mypad; padchar := chr(mypchar); eol := chr(my_eol); esc_cj of evensym: parity := evenpar; marksym: parity := markpar; nonesym: parity := nopar; oddsym: parity := oddpar; spacesym: parity := spacepar; end; (* half_duplex := false; fillparityarray end; (* onsym *) end; (* case adj *) localsym: halfduplex := (adj = onsym); paritysym: begin case adf_duplex := true; fillparityarray end; (* onsym *) offsym: begin ibm := false; parity := nopar; *) escsym: escchar := newescchar; filewarnsym: fwarn := (adj = onsym); ibmsym: case adj of onsym: begin ibm := true; parity := markpar; hal debug := true; (*$I-*) rewrite(debf,'CONSOLE:') (*I+*) end; (* onsym *) offsym: debug := false end; (* case adj end; (* paritysym *) end; (* case *) end; (* show_sym *) procedure set_parms; (* sets the parameters *) begin case noun of debugsym: case adj of onsym: begin ven'); markpar: write('Mark'); nopar: write('No'); oddpar: write('Odd'); spacepar: write('Space'); end; (* case *) writeln(' parity'); c_char)); filewarnsym: write_bool('File warning is ',fwarn); ibmsym: write_bool('IBM is ',ibm); localsym: write_bool('Local echo is ',halfduplex); paritysym: begin case parity of evenpar: write('Er: write('Odd'); spacepar: write('Space'); end; (* case *) writeln(' parity'); end; (* allsym *) debugsym: write_bool('Debugging is ',debug); escsym: writeln('Escape character is ^',ctl(es write_bool('IBM is ',ibm); write_bool('Local echo is ',halfduplex); case parity of evenpar: write('Even'); markpar: write('Mark'); nopar: write('No'); oddpable parameters *) begin case noun of allsym: begin write_bool('Debugging is ',debug); writeln('Escape character is ^',ctl(esc_char)); write_bool('File warning is ',fwarn); begin kbdfinit; rcvfinit; $writeln(chr(clear_screen)) end; (* closeup *) begin (* kermit *) " initialize; $repeat write('Kermit-UCSD> '); readstr(kq,line); case parse of unconfirmed: writeln('Unconfirmed'); parm_expected: writeln('Parameter expected'); ambiguous: writeln('Ambiguous'); unrec: writeln('Unrecognized command'); fn_expected: writeln('File name expected'); ch_expected: writeln('Sing ; Save device number in arg list (lda #0A (sta Code ; Code for wait status (lda #80 (sta Stat (SOS 083,DClst ; Do no-wait I/O to .CONSOLE (lda #00 (sta Stat (lda #0B (sta Csave it is the q (dey (lda Size+1 ; Save size in the q header (sta (Psudo),y (dey (lda Size (sta (Psudo),y ( (SOS 084,Dev_lst ; Request the device number (lda Devnum (sta DClst+1 $1 sta (Psudo),y ; Clear INP, OUTP, REF (dey (cpy #02 ; Stop at third byte in q (bne $1 (lda Ref ; Save ref no for later (sta CRef (sta (Psudo),y ; Also TABLE INFORMATIONCI4Current date is Hd*Bed on U.  P ?\ Apple //X @{BB@6bBB@ijpbZb ԳԳ@ MAXCHAR (dey ; then MAXCHAR = #char (lda Blanks (cmp (Psudo),y (bmi B INP - OUTP (bpl $3 ldy #00 (clc (lda (Psudo),y ; If INP - OUTP < 0 (adc Blanks ; then BLANKS = INP - OUTP + SIZE (sta Blanks (iny (lda (Psudo),y (adc Blanks+1 (sta Blanks+1 (Psudo),y (ldy #04 (lda (Psudo),y (ldy #06 (sec (sbc (Psudo),y ; Calculate INP - OUTP (sta Blanks (ldy #05 (lda (Psudo),y (ldy #07 (sbc (Psudo),y (sta Blanks+1 ; BLANKS = ; Are we out of chars? (bne Loop ; If not keep on going (ldy #04 (sec (lda Inpadd (sbc Base ; INP = INPADD - BASE (sta (Psudo),y (iny (lda Inpadd+1 (sbc Base+1 (sta (lda Base ; If INP points to one past eoq (sta Inpadd ; then wrap around to BASE (lda Base+1 (sta Inpadd+1 $2 inx ; Point to next char in buffer (cpx Trancnt Inpadd ; Move ahead one byte (bne $1 (inc Inpadd+1 $1 lda Inpadd (cmp Maxaddr ; Did we overflow the q? (bne $2 (lda Inpadd+1 (cmp Maxaddr+1 (bne $2 sudo),y (adc Base+1 (sta Inpadd+1 (ldy #00 ; Y-reg is index in q (ldx #00 ; X-reg is index in buffer Loop lda Buff,x (sta (Inpadd),y ; Copy one char from buf to q (inc ; MAXADDR points one past eoq (inc Maxaddr+1 $1 ldy #04 (clc (lda (Psudo),y (adc Base ; Calculate address of INP byte (sta Inpadd ; and save it in a tmp reg (iny (lda (PO^ƣ zRKERMIT PARSER HELP SENDSW RECSW numtry := 0; n := n + 1 (* bump packet number *) (* stay in data send state *) end (* else *) end (* if 'D' *) n); (* write data to file *) spack('Y',(n mod 64),0,packet); (* ACK packet *) oldtry := numtry; (* reset try counters *) if numtry > 1 then clearbuf(rq); (* clear buffer *) f *) else (* wrong number *) state := 'a' (* so abort *) end (* if *) else (* right packet *) begin bufemp(recpkt,f,le begin (* so re-ACK it *) spack('Y',num,6,packet); numtry := 0; (* reset try counter *) (* stay in same state *) end (* i(* too many tries, abort *) exit(rdata) end; (* if *) % lastn := n - 1; % if (num = (lastn mod 64)) then (* previous packet again *) if (ch = 'D') then (* got data packet *) begin if (num <> (n mod 64)) then (* wrong packet *) begin if (oldtry > maxtry) then begin rdata := 'a'; try > maxtry then begin state := 'a'; exit(rdata) end; num_try := num_try + 1; ch := rpack(len,num,recpkt); (* receive a packet *) refresh_screen(numtry,n); (* RECEIVE SECTION *) segment procedure recsw(var rec_ok: boolean); function rdata: char; (* send file data *) var num, len: integer; ch: char; begin if debug then (debugwrite('rdata'); ( repeat if numb get a list of KERMIT commands.Í7צ QUIT Same as EXIT.ÍRצ6 RECEIVE To accept a file from the remote system.Z dÍ`צD SEND To t is Control צA rightbracket followed immediately by the letter C.)Í_צC EXIT To return back to main command level of the p-system.ÍKצ/ HELP To a "virutual terminal" connection to a remoteצ system.E To break the connection and "escape" back to the micro,צB type the escape sequence (CTRL-] C, thaan also be צused to make the Cmicrocomputer behave as a terminal for a mainframe. These are the צ3commands for theUCSD p-system version, KERMIT-UCSD:ÍצB CONNECT To make7---------------Press any key to continue---------------! táצ>KERMIT is a family of programs that do reliable file transferצ6between computers over TTY lines. KERMIT cCTP)DEBUGתP)צESCAPEP)צEVENP)צEXITP)צ FILE-WARNINGP)צHELPP )צIBMP ) LOCAL-ECHOתP )MARKתP )NONEתP )ODDתP)צOFFP)ONתP)PARITYתP)QUITתP)RECEIVEתP)צSENDP)צSETP)SHOWתP)SPACEתPJv\ h:ˡ * )ALLתP)צCONNECTP)DEBUGתP)צESCAPEP)צEVENP)צEXITP)צ FILE-WARNINGP)צHELPP )צIBMP ) LOCAL-ECHOתP )MARKתP )NONEתP )ODDתP)צOFFP)ONתP á ˄ >D á˄W#MHC>94/(* *@G?< h:ˡ * )ALLתP)צCONNE˄G=83.)$ (/@ @ 8 á ˄ @ á ˄  á ˄ ܹ >D á `˄W#MH C>94/(*- ,C;852  á    áPtɡˡ R&á./0)ۥ  00ۚ)ɡ/á/0/0š. 0á..tZ ȡ.ٛ ٛٛaA6 Fٓ* áP1V @ئ Pۓ7ڛ á#PƀƀǠPڕPVVsend a file or group of files to the remote system.áÍצ= SET To establish system-dependent parameters. The * SET options are as follows: Íצ; DEBUG To set debug mode ON or OFF 0 (default is OFF).ÍצB ESCAPE To change the escape sequence that צD ˡš?YYáN @ˡ  š   gfdfázd"Eá Uaá Nˡadf$&f//'> hڡ&šš ٛ/áš  f %Eá UaáNˡaڡff/&/df$dášafgD @dff/  dgg/UNá$ @ۥǥ"á1.TEXTץáǥ%P sinit ša &   S @&UNá s YáU @ˡ  Uá á#1 requirements of the host.ÍצB SHOW To see the values of parameters that can be modifiedצD via the SET command. Options are the same as for SET,צ< except that a SHOW ALL command has been added.    rs duringצE CONNECT and file transfer to match the8 requirements of the host.ÍצB SHOW To see the values of parameters that can be modifiedצD via the SET command. Options are the same as for SET,צ< This flag selects the parity for צF outgoing and incoming characters duringצE CONNECT and file transfer to match the8 EVEN, ODD, MARK, SPACE, or NONE.צB NONE is the default but if the IBM צD flag is set, parity is set to MARK. צ@ צC duplex. It should be ON when using > the IBM and OFF for the DEC-20. NÍÍ? PARITY 4 be set appropriately צ(mark) and activatesצ, local echoing ÍE LOCAL-ECHO ON/OFF, default is OFF. This sets the should be ON only when transfering filesצB between the micro and an IBM VM/CMSצD system. It also causes the parity toצexists with the( same nameá Í ÍB IBM ON/OFF, default is OFF. This flag 6 . If ON, B Kermit will warn you and rename an D incoming file so as not to write overD a file that currently lets you return to the PC Kermit fromצ/ the remote host. The default is CTRL-] c.Íצ? FILE-WARNING ON/OFF, default is OFF6Hȡ.ٛ ٛAٛa6 F ȡۛ.áȡ(ڛ.˄צ:ˡەPȡ+ۛ@ 8Z sfile ša 6ߪP]۞ 6צ ==>   F @&$UNá# @ˡ š?YYtionצUndefined hardware errorצ$Lost unit, Unit is no longer on-lineצ)Lost file, File is no longer in directoryBad Title, Illegal file nameNo room, insu݄٨/2323ȡ2]22(b BC عNo errorBad Block, Parity error (CRC)צBad Unit NumberBad Mode, Illegal operaצP٥á;š4 P8 ˡ1P QPڛ áPT ݄ݍݍ Z`-PG> 5 ,ar$; 6 "E  \4  "a Y @&  dGBá"۩ @ˡa Y @&c Eá UaáaNZ  rinit U  SáBU&1Y @&  fEá aU áraצ Receiving rD۩D@á&Y&aZá;ša  ?D۩D@áY&aFá۩ @ˡa U  ==>  "a Y @&  dGBá"۩ @ˡa 33P]؞33P3 3P.TEXTˡ1 š 3 3P33P3צ.TEXTU3P rfile ša U  SáBša  ?TZá4۩ @ˡa Y @&  fEá Ua ˡadˡV pڪP-ƂS-"- ./Aٳ ڛٿ?1 Lڨ/צ  rdata ša U  Dáx۩ @ˡ7ša  ?D۩D@áY&a6UY @&š   FáCša  ?D۩D@áY& aáNˡa "צOpening X ˡ Sending s 򩗟^?ri `W N E <az4%M H "$P(*,.02g \  .    sbreak ša   B @&UNá# @ˡ š?YYá @ˡ   c Eá UaáNˡa "צOpening X ˡ Sending s 򩗟^?ri `W N E <az4%M Hclosing X b Eá UaáNˡa`   sbreak ša   B @&UNá# @ˡ š?YYá @ˡ   c Eá Uaá @ˡ   dEá Ua N˄a seof ša   Z @& צseof1 UNá# @ˡ š?YYá^ seof2 @ˡ   "fficient spaceצNo unit, No such volume on lineNo file, No such file on volumeצDuplicate fileצ(Not closed, attempt to open an open fileצ(Not open, attempt to close a closed fileצ,Bad format, error in reading real or integerQצRing buffer overflow' .c+\)O1 rتP1C +,+ remote host.1?S*p  "$&()á"  ,0c*2&$ Connecting to host...type CTRL-צ C to exitection, return to KERMIT-UCSD command level.S Show Status of connection? Print this list^ send the escape צcharacter itself to the : ?؞ ؞ H$ղ aA  B Send a BREAK signal.צ!C Close Conn'ũr˄N     ȡ! ]] @? ˡ9   ȡ6!!'ō'šݢLjݢljJ^!!'ō'šݢLjݢljáLN b r˄N۩ @ʀȡ+86]5]6675]75577@?786]76686]ˡ156̀5ʀȡ!85]85]558]6 8#D@NPyp!ˡܢLjܢlj]55 Trunc = "i"5̀5ʀȡ55565!̀5ʀȡ 5586]66786]667786]667ۂ786]ۿ665̀54'ō4'šhh]š]h̀iצPh5̀5ʀȡGìƀiPƀ QƀPii5]5] š̀55hʀ*ERROR: The following line is truncated at h 5h̀5ʀȡ5N]"]]!]]]R٨/2323ȡ02PáC 2]222323ȡ22Rb l#ب/s˄6444 g4'ōg ˡ]ੜˡ ߩ"Ȅ5ˡ]š á)ȡ!ޕ9q ]]]]]] ]#]N635446"ˡ"ad ȥ ߩ" Ʉ𩠰ť &ǥȡ á! ॡ1G á!]] ~"آڪP"Rڨ/6ƀƀ344ɡ4]55#á#444]55#ˡ555 á64466ƀƀ3"ˡ"a@556̀ƀ6ƀ ƀ33R   & ɡ   @ ġ  Rٹ7 A 6 +    (!9 J ,ȡ++V F ٪P  R تP, Kermit UCSD p-systemFצNumber of Packets: צNumber of Tries: צ File Name:  "ةˡ" &١ DisconnectedZ%~ȡ] ȡ١ءǀȡ] ȡ١ءǀ{ȡǀUȡ1ȡۿ EuQ/1WY@t'٪P1צon end; (* if *) spack('Y',n mod 64,0,packet); (* ok, ACK it *) close(f,lock); (* close up the file *) n := n + 1; (* bump packet counter *) state := 'f'; (*t *) end (* if 'F' *) else if (ch = 'Z') then (* end of file *) begin if (num <> (n mod 64)) then(* wrong packet, abort *) begin rdata := 'a'; exit(rdata) pty out buffer *) numtry := 0; (* reset try counter *) state := state; (* stay in same state *) end (* if *) else state := 'a' (* not previous packet, abor lastn := n - 1; if (num = (lastn mod 64)) then (* previous packet again *) begin (* so re-ACK it *) spack('Y',num,0,packet); clear_buf(rq); (* and em else if (ch = 'F') then (* file header *) begin if (oldtry > maxtry) then begin rdata := 'a'; (* too many tries, abort *) exit(rdata) end; (* if *) ruw x{v{ xvHH`hg.CONSOLEh{j^]ONMJGEB?=54'#hhKHH`(hh'&HH`.RS232+&%$"@hhhhhhhhhhZ ]bcfon ttnHH`gag.RS232srfeWVUSNIG?>:/hhdHH`(hhhhhh` cqA%צsuccessful send%unsuccessful send7)3/(  313lÍ+E r:TXF;Unrecognized commandFile name expectedSingle character expected%B B$צsuccessful receive$צunsuccessful receiveA  LjLjCx*+쥡Ekǥ* Kermit-UCSD> ե UnconfirmedצParameter expectedצ Ambiguous' )|ëtC=71+$% +'# "/'$ nr( )! #1]"]# 'WצMarkEצNo5צOdd$Space _-Q C parity' =+ + lCONSOLE:  (ë '5צOdd$Space _-Q C parity Debugging is ש(Escape character is ^File warning is ש(IBM is ש(צLocal echo is (XצEven%צoff !;RZ( Debugging is ש(Escape character is ^File warning is ש(IBM is ש(צLocal echo is (XצEvenWצMarkEצNo go to complete state *) end (* else if 'Z' *) else if (ch = 'E') then (* error packet *) begin error(recpkt,len); (* display error *) state := 'a' (* and abort *) end (* if 'E' *) else if (ch <> chr(0)) then (* some other packet type, *) state := 'a' (* abort *) until (state <> 'd'); rdata := state end; (* rdata *) function rfile: char; (* receive file header begin rfile := 'a'; exit(rfile) end; (* if *) lastn := n - 1; if num = (lastn mod 64) then (* previous packet mod 64? *) begin (* yes, ACK it again= rpack(len,num,recpkt); (* receive a packet *) refresh_screen(numtry,n); if ch = 'S' then (* send init, maybe our ACK lost *) begin if (oldtry > maxtry) then (* too many tries, abort *) begin (* rfile *) if debug then debugwrite('rfile'); if (numtry > maxtry) then (* if too many tries, give up *) begin rfile := 'a'; exit(rfile) end; numtry := numtry + 1; ch : fn := concat(fn,'.TEXT'); (* and we'll add .TEXT *) end; (* if *) if fwarn then (* if file warning is on *) checkname(fn); (* must check that name unique *) end; (* makename *) (* and make sure <= 15 *) uppercase(fn); if pos('.TEXT',fn) <> length(fn)-4 then begin if length(fn) > 10 then fn := copy(fn,1,10); (* can only be 15 long in all *) cted: writeln('File name expected'); ch_expected: writeln('Single character expected'); null: case verb of consym: connect; helpsym: help; recsym: begin 20+ase parse of unconfirmed: writeln('Unconfirmed'); parm_expected: writeln('Parameter expected'); ambiguous: writeln('Ambiguous'); unrec: writeln('Unrecognized command'); fn_expeHH`fa_^[# z 0 d j(V.2 t4n80eȱe0LL eeeȱeeȱe۠8ȥ8eȱe 00 K˝,1,15); (* stretch length *) moveleft(recpkt[0],fn[1],l); (* get filename from packet *) oldfn := copy(fn, 1,l); (* save fn sent to show user *) fn := copy(fn,1,min(15,l)); (* set length of filename *) in ['A'..'Z']) and exist(fn) do begin fn[i] := ch; ch := succ(ch); end; (* while *) i := i + 1 end; (* while *) end; (* checkname *) begin (* makename *) fn := copy(' 'this by changing letters in file name until it *) (* finds some combination which doesn't exitst *) var ch: char; i: integer; begin i := 1; while (i <= length(fn)) and exist(fn) do begin ch := 'A'; while (ch var f: file; begin (*$I-*) (* turn off i/o checking *) reset(f,fn); exist := (ioresult = 0) (*$I+*) end; (* exist *) procedure checkname(var fn: string); (* if file fn exists, makes a new name which doesn't *) (* does *) var num, len: integer; ch: char; oldfn: string; i: integer; procedure makename(recpkt: packettype; var fn: string; l: integer); function exist(fn: string): boolean; (* returns true if file named fn exists *) *) spar(packet); (* with our send init params *) spack('Y',num,6,packet); numtry := 0; (* reset try counter *) rfile := state; (* stay in same state *) end (* if *) else (* not previous packet, abort *) state := 'a' end (* if 'S' *) else if (ch = 'Z') then (* end of file *) begin if (oldtry > maxtry) then (* too many tries, abort *) else if (ch = chr(0)) then rinit := 'r' (* stay in same state *) else rinit := 'a' (* abort *) end; (* rinit *) (* state table switcher for receiving packets *) begin (* recswok *) writescn := n + 1; (* bump packet number *) rinit := 'f'; (* enter file send state *) end (* if 'S' *) else if (ch = 'E') then begin rinit := 'a'; error(recpkt,len) end (* if 'E' *) y init data *) ctl_set := [chr(1)..chr(31),chr(del),quote]; spack('Y',n mod 64,6,packet); (* ACK with my params *) oldtry := numtry; (* save old try count *) numtry := 0; (* start a new counter *) ecpkt); (* receive a packet *) refresh_screen(num_try,n); if (ch = 'S') then (* send init packet *) begin rpar(recpkt); (* get other side's init data *) spar(packet); (* fill packet with mfunction rinit: char; (* receive initialization *) var num, len: integer; (* packet number and length *) ch: char; begin if debug then debugwrite('rinit'); numtry := numtry + 1; ch := rpack(len,num,rlse if (ch = chr(0)) then (* returned false *) rfile := state (* so stay in same state *) else (* some weird state, so abort *) rfile := 'a' end; (* rfile *) end; spack('Y',n mod 64,0,packet); (* say ok *) rfile := 'c' (* go to complete state *) end (* else if *) else if (ch = 'E') then begin error(recpkt,len); rfile := 'a' end eo data state *) end (* else if *) else if ch = 'B' then (* break transmission *) begin if (num <> (n mod 64)) then (* wrong packet, abort *) begin rfile := 'a'; exit(rfile) spack('Y',n mod 64,0,packet); (* ACK file header *) oldtry := numtry; (* reset try counters *) numtry := 0; n := n + 1; (* bump packet number *) rfile := 'd'; (* switch tename) then (* try to open new file *) begin ioerror(ioresult); (* if unsuccessful, tell them *) rfile := 'a'; (* and abort *) exit(rfile) end; (* if *) rfile := 'a'; exit(rfile) end; makename(recpkt,filename,len); (* get filename, make unique if filew *) gotoxy(filepos,fileline); write(oldfn,' ==> ',filename); if not getfil(fil (* no, abort *) end (* else if *) else if (ch = 'F') then (* file header *) begin (* which is what we really want *) if (num <> (n mod 64)) then (* if wrong packet, abort *) begin begin (* yes, ACK it again *) spack('Y',num,0,packet); numtry := 0; rfile := state (* stay in same state *) end (* if *) else rfile := 'a' begin rfile := 'a'; exit(rfile) end; (* if *) lastn := n - 1; if num = (lastn mod 64) then (* previous packet mod 64? *) reen('Receiving'); state := 'r'; (* initial state is send *) n := 0; (* set packet # *) numtry := 0; (* no tries yet *) while true do if state in ['d', 'f', 'r', 'c', 'a'] then case state of 'd': state := rdata; 'f': state := rfile; 'r': state := rinit; 'c': begin rec_ok := true; exit(recsw) end; (* case c *) } segment procedure sendsw(var send_ok: boolean); var io_status: integer; procedure openfile; (* resets file & gets past first 2 blocks *) begin (*$I-*) (* turn off compiler i/o checkin } { Therefore, /pro/copy/fname.text } { becomes FNAME.TEXT, } { not PROCOPYFNAME.TEXT. } { (* Send Section *) {Modified 03-16-85 AMB: Original took full pathname, without '/' } { or leading '.', as new file name. This } { mod removes unit and directory names. } {  O^5 exit(recsw) end (* else *) end; (* recsw *) 'a': begin rec_ok := false; exit(recsw) end (* case a *) end (* case *) else (* state not in legal states *) begin rec_ok := false; g temporarily *) reset(oldf,filename); (*$I+*) (* turn compiler i/o checking back on *) io_status := io_result; if (iostatus = 0) then if (pos('.TEXT',filename) = length(filename) - 4) then (* is a text file, so *) i := blockread(oldf,filebuf,2); (* skip past 2 block header *) end; (* openfile *) function sinit: char; (* send init packet & receive other side's *) var num,a := state; (* stay in same state *) exit(sdata); (* get out of here *) end; (* if *) if numtry > 1 then clear_buf(rq); (* if anything in buffer, flush it *) = 63; ch := 'Y'; (* and indicate an ACK *) end; (* else *) if (ch = 'Y') then begin if ((n mod 64) <> num) then (* if wrong ACK *) begin sdat else (* is just like ACK for this packet *) begin if num > 0 then num := (num - 1) (* in which case, decrement num *) else num : if ch = 'N' then (* NAK, so just stay in this state *) if ((n+1) mod 64 <> num) then (* unless NAK for next, which *) sdata := state nt],packarray[current]); refresh_screen(numtry,n); (* set up next packet *) sizearray[b] := bufill(packarray[b]); ch := rpack(len,num,recpkt); (* receive a packet *) then (* if too many tries, give up *) state := 'a'; b := other(current); numtry := numtry + 1; (* send a data packet *) spack('D',n mod 64,sizearray[curre if b then other := false else other := true end; (* other *) begin current := true; packarray[current] := packet; sizearray[current] := size; while (state = 'd') do begin if (numtry > maxtry) packarray: array[false..true] of packettype; sizearray: array[false..true] of integer; current: boolean; b: boolean; function other(b: boolean): boolean; (* complements a boolean which is used as array index *) begin it := 'a' end (* if 'E' *) else if (ch = chr(0)) then sinit := state else if (ch <> 'N') then sinit := 'a' end; (* sinit *) function sdata: char; (* send file data *) var num, len: integer; ch: char; chr(31),chr(del),quote]; numtry := 0; n := n + 1; (* increase packet number *) sinit := 'f'; exit(sinit) end (* else if 'Y' *) else if (ch = 'E') then begin error(recpkt,len); sin if (eol = chr(0)) then (* if they didn't spec eol *) eol := chr(my_eol); (* use mine *) if (quote = chr(0)) then (* if they didn't spec quote *) quote := my_quote; (* use mine *) ctl_set := [chr(1)..if 'N' *) else if (ch = 'Y') then begin if ((n mod 64) <> num) then (* not the right ack *) begin sinit := state; exit(sinit) end; rpar(recpkt); ; spar(packet); clear_buf(rq); refresh_screen(numtry,n); spack('S',n mod 64,6,packet); ch := rpack(len,num,recpkt); if (ch = 'N') then begin sinit := 's'; exit(sinit) end (* len, i: integer; (* packet number and length *) ch: char; begin if debug then debugwrite('sinit'); if numtry > maxtry then begin sinit := 'a'; exit(sinit) end; num_try := num_try + 1 numtry := 0; n := n + 1; current := b; if sizearray[current] = ateof then state := 'z' (* set state to eof *) else state := 'd' (* else stay in data state *) end (* if *) else if (ch = 'E') then begin error(recpkt,len); state := 'a' end (* if 'E' *) else if (c begin if (num > 0) then num := (num - 1) (* in which case, decrement num *) else num := 63; ch := 'Y'; (* and indicate an ACK *) end; (* else *) cpkt); if ch = 'N' then (* NAK, so just stay in this state *) if ((n+1) mod 64 <> num) then (* unless NAK for next packet, which *) exit(sfile) (* is just like ACK for this packet *) else spack('F',n mod 64,len,fn); (* send file header packet *) size := bufill(packet); (* get first data from file *) (* while waiting for response *) ch := rpack(len,num,re(filename); moveleft(filename[1],fn[0],len); (* move filename into a packettype *) gotoxy(filepos,fileline); write(oldfn,' ==> ',filename); refresh_screen(numtry,n); (* if too many tries, give up *) begin sfile := 'a'; exit(sfile) end; numtry := numtry + 1; oldfn := filename; legalize(filename); (* make filename acceptable to remote *) len := lengthnot(fn[i] in ['a'..'z','A'..'Z','.','0'..'9']) then delete(fn,i,1) else i := i + 1; uppercase(fn) end; (* legalize *) begin if debug then debugwrite('sfile'); if (numtry > maxtry) then delete(fn,j,1);l := l - 1 end; (* for i *) l := length(fn); i := pos(':',fn); if (i <> 0) then begin fn := copy(fn,i,l-i); l := length(fn) end; i := 1; while (i <= length(fn)) do if if fn[i] = '.' then count := count + 1; for i := 1 to count-1 do (* remove all but 1 *) begin j := 1; while (j < l) and (fn[j] <> '.') do j := j + 1; ) + ord(s[i]) - ord('a')) end; (* uppercase *) " begin strip_dir (fn); {03-16-85} $count := 0; l := length(fn); for i := 1 to l do (* count '.'s in fn *) } $end;{while not found} $if i > 0 then delete (s, 1, i); "end; (* strip_dir *) " procedure uppercase(var s: string); ' "var i: integer; begin for i := 1 to length(s) do if s[i] in ['a'..'z'] then s[i] := chr(ord('A'$not_found := true; $i := length (s) + 1; $while (not_found) do begin )if i > 0 then begin ,i := i - 1; ,if i > 0 then begin /if s[i] = '/' then not_found := false; /end ,else not_found := false; ,{endif} ,end )else not_found := false; ){endifg); (* make sure file name will be legal to other computer *) var count, i, j, l: integer; "procedure strip_dir(var s: string); {03-15-85} ' "var i: integer; ¬_found: boolean; begin t]; packet := packarray[current]; sdata := state end; (* sdata *) function sfile: char; (* send file header *) var num, len, i: integer; ch: char; fn: packettype; oldfn: string; procedure legalize(var fn: strinh = chr(0)) then (* receive failure, so stay in d *) begin end else if (ch <> 'N') then state := 'a' (* on any other goto abort state *) end; (* while *) size := sizearray[curren if (ch = 'Y') then begin if ((n mod 64) <> num) then (* if wrong ACK, stay in F state *) exit(sfile); numtry := 0; n := n + 1; sfile := 'd'; end (* if *) else if (ch = 'E') then begin error(recpkt,len); sfile := 'a' end (* if 'E' *) else if (ch <> chr(0)) and (ch <> 'N') then (* don't recognize it *) sfile := 'a' end; (* sfile *) function seof: char; (* send end of file *) begin (* sendsw *) if debug then debugwrite(concat('Opening ',filename)); openfile; if io_status <> 0 then begin writeln(chr(clear_screen)); io_error(io_status); send_ok := false; exit if (ch = chr(0)) then (* receive failed, so stay in z state *) begin end else if (ch <> 'N') then (* other error, just abort *) sbreak := 'a' end; (* sbreak *) (* state table switcher for sending *) numtry := 0; n := n + 1; sbreak := 'c' (* else, switch state to complete *) end (* if *) else if (ch = 'E') then begin error(recpkt,len); sbreak := 'a' end (* if 'E' *) else num := 63; ch := 'Y'; (* and indicate an ACK *) end; (* else *) if (ch = 'Y') then begin if ((n mod 64) <> num) then (* if wrong ACK, stay in B state *) exit(sbreak); ext packet, which *) exit(sbreak) (* is just like ACK for this packet *) else begin if num > 0 then num := (num - 1) (* in which case, decrement num *) else ry,n); spack('B',(n mod 64),0,packet); (* send end of file packet *) ch := rpack(len,num,recpkt); if ch = 'N' then (* NAK, so just stay in this state *) if ((n+1) mod 64 <> num) then (* unless NAK for n begin if debug then debugwrite('sbreak'); if (numtry > maxtry) then (* if too many tries, give up *) begin sbreak := 'a'; exit(sbreak) end; numtry := numtry + 1; refresh_screen(numt begin end else if (ch <> 'N') then (* other error, just abort *) seof := 'a' end; (* seof *) function sbreak: char; var num, len: integer; ch: char; (* send break (end of transmission) *) ; close(oldf); seof := 'b' end (* if *) else if (ch = 'E') then begin error(recpkt,len); seof := 'a' end (* if 'E' *) else if (ch = chr(0)) then (* receive failed, so stay in z state *) if debug then debugwrite('seof2'); if ((n mod 64) <> num) then (* if wrong ACK, stay in F state *) exit(seof); numtry := 0; n := n + 1; if debug then debugwrite(concat('closing ',s)) num := (num - 1) (* in which case, decrement num *) else num := 63; ch := 'Y'; (* and indicate an ACK *) end; (* else *) if (ch = 'Y') then begin AK, so just stay in this state *) if ((n+1) mod 64 <> num) then (* unless NAK for next packet, which *) exit(seof) (* is just like ACK for this packet *) else begin if num > 0 then mtry + 1; refresh_screen(numtry,n); spack('Z',(n mod 64),0,packet); (* send end of file packet *) if debug then debugwrite('seof1'); ch := rpack(len,num,recpkt); if ch = 'N' then (* N var num, len: integer; ch: char; begin if debug then debugwrite('seof'); if (numtry > maxtry) then (* if too many tries, give up *) begin seof := 'a'; exit(seof) end; numtry := nu(sendsw) end; write_screen('Sending'); state := 's'; n := 0; (* set packet # *) numtry := 0; while true do if state in ['d', 'f', 'z', 's', 'b', 'c', 'a'] then case state of 'd': state := sdata; 'f': state := sfile; 'z': state := seof; 's': state := sinit; 'b': state := sbreak; 'c': begin send_ok := true; *) begin send_ok := false; exit(sendsw) end (* else *) end; (* sendsw *) exit(sendsw) end; (* case c *) 'a': begin send_ok := false; exit(sendsw) end (* case a *) end (* case *) else (* state not in legal states