LnSOS BOOT 1.1 SOS.KERNEL SOS KRNLI/O ERRORFILE 'SOS.KERNEL' NOT FOUND%INVALID KERNEL FILE: xةw,@  ȱlmi8#)!)O^±±READ.ME.FIRST9p%!/PPKEYWORDS.TEXT<4+PPRINT.CODEK)P*TIMER.CODE31*TIMER.TEXT82,WEEKDAY.CODE&& ,WEEKDAY.TEXT %!III.PCL.13u' .ASMFORMAT.CODE* ,FILEDIV.CODE 8! ,FILEDIV.TEXT=x6*-NINE2ONE.CODE &!NINE2ONE.EXEC$&!-NINE2ONE.TEXT >dLԡm#i㰼m#iЕOLԡȱfg hi !dLԡ憦  Ljmkm l y`2 Lԡ8(Je稽)ʈ@L  11 : m := 4; 12 : m := 6; END; { *CASE date.year OF 1700..1799 : c := 4; 1800..1899 : c := 2; 1900..1999 : c := 0; 2000..2099 : c := 6; 2100..2199 : c := 4; ap_year(date.year) THEN m := 3 ELSE m := 4; 3 : m := 4; 4 : m := 0; 5 : m := 2; 6 : m := 5; 7 : m := 0; 8 : m := 3; 9 : m := 6; 10 : m := 1; END; IF good THEN BEGIN IF leap_year(date.year) THEN WRITELN(date.year:1,' is a Leap Year'); CASE date.month OF 1 : IF leap_year(date.year) THEN m := 0 ELSE m := 1; 2 : IF le ELSE BEGIN IF (date.month < 1) OR (date.month > 12) THEN good := FALSE ELSE BEGIN IF (date.month_day < 1) OR (date.month_day > 31) THEN good := FALSE; END; the_year MOD 400 = 0) THEN leap_year := TRUE; END; { ------------------------------------------------------------------------- } BEGIN good := TRUE; IF (date.year < 1752) OR (date.year > 2199) THEN good := FALSE ; { ------------------------------------------------------------------------- } FUNCTION leap_year (the_year : INTEGER) : BOOLEAN; BEGIN leap_year := FALSE; IF ((the_year MOD 4 = 0) AND (the_year MOD 100 <> 0)) OR ({ ------------------------------------------------------------------------- } PROCEDURE date_to_day ( date : date_record; VAR day : day_kind; VAR good : BOOLEAN); VAR w,s,y,m,d,c : INTEGER month_day : INTEGER; END; day_kind = (saturday,sunday,monday,tuesday,wednesday,thursday,friday); VAR user_date : date_record; user_day : day_kind; good_date : BOOLEAN; 988, pp. 77+ * } { *********************************************************** } PROGRAM Gregorian_Date_to_Day; TYPE date_record = RECORD year : INTEGER; month : INTEGER; * } { * * } { * Reference: "Project Management and the Calendar" * } { * Computer Language magazine * } { * Jan. 1 { *********************************************************** } { * Determine the day for a given date (David Craig 1988) * } { * * } { * Example: July 4, 1946 --> Thursday END; *} * *IF (date.year >= 1700) AND (date.year <= 1799) THEN c := 4; *IF (date.year >= 1800) AND (date.year <= 1899) THEN c := 2; *IF (date.year >= 1900) AND (date.year <= 1999) THEN c := 0; *IF (date.year >= 2000) AND (date.year <= 2099) THEN c := 6; *IF (date.year >= 2100) AND (date.year <= 2199) THEN c := 4; y := date.year MOD 100; d := date.month_day; s := y + (y DIV 4) + m + d + c; w := s MOD 7 { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] [] [] ---------------------------------------------------------------- [] [] N I N E T O O N E !"#$%&'()*+,-./0123456789:stuvwxyz{|}~O^ { THE END } day : WRITELN('tuesday'); wednesday : WRITELN('wednesday'); thursday : WRITELN('thursday'); friday : WRITELN('friday'); END; END; WRITELN; WRITELN('That''s all, Folks ...'); END. WRITELN('The date is not good !') ELSE BEGIN WRITE('The day is '); CASE user_day OF saturday : WRITELN('saturday'); sunday : WRITELN('sunday'); monday : WRITELN('monday'); tuesr ); WRITE('Enter Month (1-12 ) ? '); READLN(user_date.month ); WRITE('Enter Day (1-31 ) ? '); READLN(user_date.month_day); WRITELN; date_to_day (user_date,user_day,good_date); IF NOT(good_date) THEN END; END; END; { ------------------------------------------------------------------------- } BEGIN WRITELN('Calendar Date to Day utility by David Craig - 1988'); WRITELN; WRITE('Enter Year (1752+) ? '); READLN(user_date.yea; CASE w OF 0 : day := saturday; 1 : day := sunday; 2 : day := monday; 3 : day := tuesday; 4 : day := wednesday; 5 : day := thursday; 6 : day := friday; E Q U A L S 1 0 0 [] [] ---------------------------------------------------------------- [] [] [] [] AUTHOR : David T. Craig (736 Edgewater, Wichita KS 67230) [] [] DATE : October 1987 [] [] LANGUAGE : Apple /// Pascal 1.1 [] [] COMPUTER : Apple /// [] [] g_TallyInfo : t_TallyInfo; { Tally information } { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] [] [] M A J O R R O U T I NS * ********************************************************************** } VAR g_UserIsDone : BOOLEAN; { User termination flag } g_UserCommand : t_UserCommand; { User command } order : t_TallyOrder; { Tally order } match : t_BIGInteger; { Tally match value } END; { ********************************************************************** * GLOBAL VARIABLE Ascending (1,2,3,4,5,6,7,8,9) } order_Descending); { Descending (9,8,7,6,5,4,3,2,1) } { Large integer } t_BIGInteger = INTEGER[12]; { > 987654321 [///] } { Tally information } t_TallyInfo = RECORD us_AscendingOrder, { Set digit ascending order } us_DescendingOrder, { Set digit descending order } uc_Quit); { Quit } { Tally order } t_TallyOrder = (order_Ascending, {ES * ********************************************************************** } TYPE { User command } t_UserCommand = (uc_None, { No command } uc_ShowTally, { Show tally } 'David Craig'; { Author's name } k_PgmVersion = '1.00'; { Program version } k_PgmDate = 'October 1987'; { Program date } { ********************************************************************** * GLOBAL TYPG } " { ********************************************************************** * GLOBAL CONSTANTS * ********************************************************************** } CONST k_PgmAuthor = * COMPILER OPTIONS * ********************************************************************** } {$RANGECHECK-} { RANGE CHECKING } "{$IOCHECK- } { I/O CHECKING } "{$VARSTRING- } { VAR STRING CHECKIN [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } PROGRAM Nine_to_One_equals_100; { ********************************************************************** [] Diversions [] [] Martin Gardner, 1969 [] [] See pages 175-176, 183. [] [] [] [] ---------------------------------------------------------------- [] [] [] [] REFERENCE : The Unexpected Hanging and Other Mathematical [] [] consists of inserting mathematical signs wherever [] [] one desires between the digits in the ordered list [] [] 1,2,3,4,5,6,7,8,9 to make the expression equal 100 [] [] [] [] ---------------------------------------------------------------- [] [] [] [] PURPOSE : This program solves an old numerical problem which [] E S [] [] [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE : Introduction | PURPOSE : Introduce the program to the user | INPUT : (none) | OUTPUT : (none) | NOTES : (none) |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE Introduction; TYPE t_Phrase = ST END; UNTIL (user_command <> uc_None); END; { ----- Fetch_UserCommand ----- } { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE : Execute_UserCommand | PURPOSE : Execute the user's command | INPUT WRITELN; IF (quit_answer = 'Y') OR (quit_answer = 'y') THEN user_is_done := TRUE; END; OTHERWISE user_command := uc_None; END; 'D','d' : user_command := us_DescendingOrder; 'Q','q' : BEGIN user_command := uc_Quit; WRITE('Are you sure you wish to QUIT (Y/N) ? '); READ(quit_answer); AT BEGIN WRITELN; WRITE('COMMAND: ',k_Prompt); READ(command); WRITELN; CASE command OF 'S','s' : user_command := uc_ShowTally; 'A','a' : user_command := us_AscendingOrder; CONST k_Prompt = 'S)howTally A)scendingOrder D)escendingOrder Q)UIT ? '; VAR command : CHAR; quit_answer : CHAR; BEGIN { ----- Fetch_UserCommand ----- } user_is_done := FALSE; { Assume user wants more } REPEer_is_done - User termination flag | NOTES : (none) |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE Fetch_UserCommand(VAR user_command : t_UserCommand; VAR user_is_done : BOOLEAN); --- Aufwiedersehen ----- } { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE : Fetch_UserCommand | PURPOSE : Fetch a command from the user | INPUT : (none) | OUTPUT : user_command - User command | us| OUTPUT : (none) | NOTES : (none) |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE Aufwiedersehen; BEGIN { ----- Aufwiedersehen ----- } WRITELN; WRITELN('That''s all, Folks ...'); END; { -- g_TallyInfo.order := order_Ascending; END; { ----- Initialize ----- } { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE : Aufwiedersehen | PURPOSE : Say some parting words to the user | INPUT : (none) the program | INPUT : (none) | OUTPUT : Tally order set to ascending | NOTES : (none) |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE Initialize; BEGIN { ----- Initialize ----- } 00.'); WRITELN; w('For example, the sequence 1 + 2 + 34 - 5 + 67 - 8 + 9 = 100'); END; { ----- Introduction ----- } { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE : Initialize | PURPOSE : Initialize w('This program displays the tallies for an old numerical problem'); w('where the mathematical signs of addition & subtraction are placed'); w('as desired between the ordered digits 1,2,3,4,5,6,7,8,9'); w('so that the expression equals 1{ ---------------------------------------------------------------------- } BEGIN { ----- Introduction ----- } WRITELN('NINE TO ONE EQUALS 100 - Version ',k_PgmVersion); WRITELN('Not (c) ',k_PgmDate,' by ',k_PgmAuthor); WRITELN; RING[79]; { ---------------------------------------------------------------------- } PROCEDURE w(phrase : t_Phrase); BEGIN { ----- w ----- } WRITELN(phrase); END; { ----- w ----- } : user_command - User command | OUTPUT : (none) | NOTES : (none) |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE Execute_UserCommand(user_command : t_UserCommand); { ---------------------------------------------------------------------- | Routine : Do_ShowTally | Purpose : Show the tally sequences which match the user's number | Input : (none) | Output : (none) ---------------------------------------------------------------------- } PROCEDUR{ ---------------------------------------------------------------------- } PROCEDURE setup_expression_string; VAR d_index : 1..9; op_index : 1..8; BEGIN { ----- setup_expression_string ----- } k_MinusOpCode : opcode_list[op_index] := op_Minus; k_DontCareOpCode : opcode_list[op_index] := op_X; END; END; END; { ----- setup_opcode_list ----- } VAR op_index : 1..8; BEGIN { ----- setup_opcode_list ----- } FOR op_index := 1 TO 8 DO BEGIN CASE sign_list[op_index] OF k_PlusOpCode : opcode_list[op_index] := op_Plus; ORD(sum > 2); IF (sum > 2) THEN sign_list[1] := 0 ELSE sign_list[1] := sum; END; { ----- increment_sign_list_by_one ----- } { ---------------------------------------------------------------------- } PROCEDURE setup_opcode_list; IF (sum > 2) THEN sign_list[3] := 0 ELSE sign_list[3] := sum; sum := sign_list[2] + carry; carry := ORD(sum > 2); IF (sum > 2) THEN sign_list[2] := 0 ELSE sign_list[2] := sum; sum := sign_list[1] + carry; carry := list[5] := sum; sum := sign_list[4] + carry; carry := ORD(sum > 2); IF (sum > 2) THEN sign_list[4] := 0 ELSE sign_list[4] := sum; sum := sign_list[3] + carry; carry := ORD(sum > 2); ; sum := sign_list[6] + carry; carry := ORD(sum > 2); IF (sum > 2) THEN sign_list[6] := 0 ELSE sign_list[6] := sum; sum := sign_list[5] + carry; carry := ORD(sum > 2); IF (sum > 2) THEN sign_list[5] := 0 ELSE sign_um := sign_list[8] + 1; carry := ORD(sum > 2); IF (sum > 2) THEN sign_list[8] := 0 ELSE sign_list[8] := sum; sum := sign_list[7] + carry; carry := ORD(sum > 2); IF (sum > 2) THEN sign_list[7] := 0 ELSE sign_list[7] := sum{ ---------------------------------------------------------------------- } PROCEDURE increment_sign_list_by_one; VAR carry : INTEGER; sum : INTEGER; BEGIN { ----- increment_sign_list_by_one ----- } sn_list[3] := 0; sign_list[4] := 0; sign_list[5] := 0; sign_list[6] := 0; sign_list[7] := 0; sign_list[8] := 0; END; { ----- init_sign_list_to_zero ----- } K : BOOLEAN; { ---------------------------------------------------------------------- } PROCEDURE init_sign_list_to_zero; BEGIN { ----- init_sign_list_to_zero ----- } sign_list[1] := 0; sign_list[2] := 0; sigdeList; digit_list : t_DigitList; expr_string : t_ExprString; old_expr_str : t_ExprString; expr_value : t_BIGInteger; match_count : t_BIGInteger; digit_overflow : BOOLEAN; conversion_O t_SignList = ARRAY [1..8] OF 0..2; t_OpKode = (op_Plus,op_Minus,op_X); t_OpcodeList = ARRAY [1..8] OF t_OpKode; t_ExprString = STRING[17]; VAR sign_list : t_SignList; opcode_list : t_OpcoE Do_ShowTally; CONST k_AscendingList = '123456789'; k_DescendingList = '987654321'; k_PlusOpCode = 0; k_MinusOpCode = 1; k_DontCareOpCode = 2; TYPE t_DigitList = STRING[9]; {'12345678901234567'} expr_string := ' '; FOR d_index := 1 TO 9 DO expr_string[(d_index-1)*2+1] := digit_list[d_index]; FOR op_index := 1 TO 8 DO CASE opcode_list[op_index] OF op_Plus : expr_string[op_index+op_index] := '+'; op_Minus : expr_string[op_index+op_index] := '-'; op_X : expr_string[op_index+op_index] := ' '; END; WHILE POS(' ',expr_string) > 0 DO BEGIN { ----- handle_number_token ----- } token := '?'; str_digit := '?'; token[1] := expr_string[ch_posn]; REPEAT BEGIN digit_found := FALSE; ch_posn := ch_p} PROCEDURE handle_number_token; VAR str_digit : STRING[1]; left_operand : t_BIGInteger; rite_operand : t_BIGInteger; lr_operator : t_BIGInteger; digit_found : BOOLEAN; ckSize) THEN WRITELN('*** INVALID STACK POINTER [PULL] ***') ELSE value_to_pull := expr_stack[expstk_ptr]; END; { ----- pull_value ----- } { ---------------------------------------------------------------------- ------------------------------------------------------ } PROCEDURE pull_value(VAR value_to_pull : t_BIGInteger); BEGIN { ----- pull_value ----- } expstk_ptr := expstk_ptr - 1; IF (expstk_ptr < 0) OR (expstk_ptr >= k_Sta expr_stack[expstk_ptr] := value_to_push; expstk_ptr := expstk_ptr + 1; stack_full := (expstk_ptr = k_StackSize); END; END; { ----- push_value ----- } { ------------------ push_value ----- } stack_full := FALSE; IF (expstk_ptr < 0) OR (expstk_ptr >= k_StackSize) THEN WRITELN('*** INVALID STACK POINTER [PUSH] ***') ELSE BEGIN END; { ----- number_found ----- } { ---------------------------------------------------------------------- } PROCEDURE push_value( value_to_push : t_BIGInteger; VAR stack_full : BOOLEAN); BEGIN { --- stk_full : BOOLEAN; { ---------------------------------------------------------------------- } FUNCTION number_found : BOOLEAN; BEGIN { ----- number_found ----- } number_found := (expr_string[ch_posn] IN ['1'..'9']); VAR ch_posn : INTEGER; expr_length : INTEGER; token : t_ExprString; token_value : t_BIGInteger; operator : CHAR; expr_stack : t_ExpStack; expstk_ptr : INTEGER; ------------- } PROCEDURE evaluate_expression_value(VAR result : t_BIGInteger); CONST k_StackSize = 3; *k_StkSizem1 = 2; { k_StackSize - 1 } TYPE t_ExpStack = ARRAY [0..k_StkSizem1] OF t_BIGInteger; 0'); value := (value * 10) + digit; END; END; UNTIL (c_index = LENGTH(str_num)) OR NOT(conv_OK); END; { ----- str_to_value ----- } { ---------------------------------------------------------c_index := 0; REPEAT BEGIN c_index := c_index + 1; conv_OK := (str_num[c_index] IN ['0'..'9']); IF conv_OK THEN BEGIN digit := ORD(str_num[c_index]) - ORD(' VAR value : t_BIGInteger; VAR conv_OK : BOOLEAN); VAR c_index : INTEGER; digit : 0..9; BEGIN { ----- str_to_value ----- } value := 0; DELETE(expr_string,POS(' ',expr_string),1); END; { ----- setup_expression_string ----- } { ---------------------------------------------------------------------- } PROCEDURE str_to_value( str_num : t_ExprString; osn + 1; IF (ch_posn <= expr_length) THEN BEGIN IF number_found THEN BEGIN digit_found := TRUE; str_digit[1] := expr_string[ch_posn]; token := CONCAT(token,str_digit); END; END; END UNTIL NOT(digit_found) OR (ch_posn > expr_length); str_to_value(token,token_value,conversion_OK); push_valu * ---------------------------------------------------------------------- * APPLESTUFF UNIT * ---------------------------------------------------------------------- RANDOM RANDOMIZE KEYPRESS JOYSTICK SOUND DATE TIMEOFDAY CLOCKINFO SETTIME PADDLE BUTTON NO Keyword files are text files * [2] All lines starting with an '*' are comments * [3] Each keyword occupies one line * [4] Keyword case is unimportant * [5] Other keyword files may be included by using a line as; * ?@ABCDEFGHIO^ŰŰ { On the last stack computation the } { returned result will be correct. } result := token_value; END ELSE WRITELN('*** INVALID OPERAND ***'); } push_value(token_value,stk_full); { Return computed value to caller even } { tho current value may not represent } { the total expression value. } perand ELSE token_value := left_operand - rite_operand; { Save the newly computed value back onto the stack } { for the next expression values IF (lr_operator = ORD('+')) OR (lr_operator = ORD('-')) THEN BEGIN IF (lr_operator = ORD('+')) THEN token_value := left_operand + rite_oe(token_value,stk_full); IF stk_full THEN { Compute stack contents } BEGIN pull_value(rite_operand); pull_value(lr_operator ); pull_value(left_operand); TE * ---------------------------------------------------------------------- * CHAINSTUFF UNIT * ---------------------------------------------------------------------- setchain setcval getcval set_prefix get_prefix get_pathname * ---------------------------------------------------------------------- * PGRAF UNIT * ---------------------------------------------------------------------- Screencolor Black Magenta DarkBlue Purple DarkGreen Grey1 MedBlue LightBlue Br SOS_Volume SOS_Set_Prefix SOS_Get_Prefix SOS_Open SOS_New_Line SOS_Read SOS_S_Read SOS_Write SOS_S_Write SOS_Close SOS_Flush SOS_Get_B_Mark SOS_Get_B_EOF SOS_Set_B_Mark SOS_Set_B_EOF SOS_Get_Mark SOS_Get_EOF SOS_Set_Mark SOS_Set_EOF SO------------------------------------------------ * SOSIO UNIT * ---------------------------------------------------------------------- SOS_D_Status SOS_D_Control SOS_Get_D_Num SOS_D_Info SOS_Create SOS_Destroy SOS_Rename SOS_Set_Info SOS_Get_Info* ---------------------------------------------------------------------- * ELEMS UNIT * ---------------------------------------------------------------------- Log2X LnX Ln1X Exp2X ExpX Exp1X XpwrI XpwrY Compound Annuity * ----------------------2X S2Str D2Str C2Str X2Str Str2S Str2D Str2C Str2X RemX SqrtX RintX NegX AbsX CpySgnX NextS NextD NextX ClassS ClassD ClassC ClassX ScalbX LogbX SetRnd SetEnv GetRnd GetEnv TestXcp SetXcp TestHlt SetHlt ERO NORMAL DENORMAL DecForm style digits AddS AddD AddC AddX SubS SubD SubC SubX MulS MulD MulC MulX DivS DivD DivC DivX CmpX RelX I2X S2X D2X C2X X2X X2I X2S X2D X2C S2Dec D2Dec C2Dec X2Dec Dec2S Dec2D Dec2C Decd SigDig DecStr Decimal sgn exp sig Environ RoundDir TONEAREST UPWARD DOWNWARD TOWARDZERO RelOp GT LT GL EQ GE LE GEL UNORD Exception INVALID UNDERFLOW OVERFLOW DIVBYZERO INEXACT NumClass SNAN QNAN INFINITE ZFWRITEREAL SUPER_MOD SUPER_DIV StrToNum NumToStr * ---------------------------------------------------------------------- * SANE UNIT * ---------------------------------------------------------------------- SIGDIGLEN DECSTRLEN Single Double Comp Extende------------------------------------------- SIN COS EXP ATAN LN LOG * ---------------------------------------------------------------------- * PASCALIO UNIT * ---------------------------------------------------------------------- FSEEK FREADREAL tclos setdnorm getdnorm finite isNaN integral unordered infinity maxreal minnorm minreal makeNaN copysign logb scalb nextafter sqrt rem * ---------------------------------------------------------------------- * TRANSCEND UNIT * ------------------------------------------------- numenv rmode rnear rpos rneg rzero closure proj affine denorm warning normalizing xcpn invop underfl overfl div0 inxact cvtovfl savenv restenv setxcpn getxcpn sethalt gethalt setround getround setclos gePENCOLOR TEXTMODE GRAFMODE FILLSCREEN VIEWPORT TURTLEX TURTLEY TURTLEANG SCREENBIT DRAWBLOCK WCHAR WSTRING CHARTYPE * ---------------------------------------------------------------------- * REALMODE UNIT * ------------------------------------------------EGRAPHICS UNIT * ---------------------------------------------------------------------- SCREENCOLOR NONE WHITE BLACK REVERSE RADAR BLACK1 GREEN VIOLET WHITE1 BLACK2 ORANGE BLUE WHITE2 INITTURTLE TURN TURNTO MOVE MOVETO On TextOn FillPort PenColor FillColor XfrOption SetCTab Viewport MoveTo MoveRel DotAt DotRel LineTo LineRel NewFont SysFont DrawImage XYcolor Xloc Yloc GSave GLoad InitGrafix * ---------------------------------------------------------------------- * TURTLown Orange Grey2 Pink Green Yellow Aqua White GMode BW280 CP280 BW560 COL140 GBuf XfrMode GSCBptr GSCB GHMode GSMode GPX GPY GVL GVR GVB GVT GCF GCB GFont CWidth CHeight GColTab FotoFile GrafixMode GrafixS_Set_Lev SOS_Get_Lev SOS_S_Fence SOS_G_Fence SOS_Set_Time SOS_Get_Time SOS_Get_Analog SOS_Terminate SOS_Request_Seg SOS_Find_Seg SOS_Change_Seg SOS_G_Seg_Info SOS_G_Seg_Numb SOS_Rel_Seg Up_Load At_Sign ******************************************************************** * End of keyword file --- Aufwiedersehen ******************************************************************** VE צLABEL צLENGTH LN׮ צLOCK LOG׮ LONGINT׮ MARK׮ צMAXINT MEMAVAIL׮ צMEMLOCK צMEMSWAP צMETHODS צMOD צMOVELEFT MOVERIGHT׮ NEW׮ NIL׮ NT׮ צIDSEARCH IF׮ צIMPLEMENTATION IN׮ צINLINE INPUT׮ INSERT׮ צINTEGER צ INTERACTIVE צ INTERFACE צ INTRINSIC צIORESULT  צKEYBOARD KEYPRESS׮ צLEAE END׮ EOF׮ EOLN׮ צEXIT EXP׮ EXTENDED׮ צEXTERNAL FALSE׮ FILE׮ צFILLCHAR FOR׮ FORWARD׮ FUNCTION׮ צGET צGOTO GOTOXY׮ צHALT HEAPRESUL CLOSE׮ CODE׮ צCOMP CONCAT׮ צCONST צCOPY COS׮ CREATION׮ צCRUNCH CYCLE׮ DATA׮ צDELETE DISPOSE׮ DIV׮ DO׮ צDOUBLE DOWNTO׮  צELS .)׮ צ???z  צ??? צABS צAND צATAN ARCTAN׮ צARRAY צATTACH BEGIN׮ BLOCKREAD׮ BLOCKWRITE׮ צBOOLEAN צ BYTESTREAM CASE׮ צCHAR CHR׮ . , ( ) : ; ^ @ { } ~ ` ' # $ % _ | \ ? " ! & צ<> <=׮ צ>= :=׮ צ.. **׮ צ(* *)׮ צ(.š5ٛ ٛٛaAá2FتšEE>  צ??? צ??? + - * / = < > [ ]JLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqr@@nd 9PRETTYPRUTOKENSE ORMAL׮ צNOT צODD צOF OR׮ צORD צORD4 OTHERWISE׮ OUTPUT׮ צPACK PACKED׮ צPAGE PMACHINE׮ צPOINTER צPOS צPRED PROCEDURE׮ PROCESS׮ PROCESSID׮ PROGRAM׮ PURGE׮ PUT׮ PWROFTEN׮v  צREAD READLN׮ צREAL RECORD׮ צRELEASE צREPEAT RESET׮ REWRITE׮ ROUND׮ SCAN׮ צSCANEQ SCANNE׮ ȄȄ ánb áNN áE: áe&áqá Q$ i]QE999! ( AZȄAašٛٛٹAAY"XY!"DZ   ȡ S Ȅ C Ȅ 3 Ȅ #     ɡd & ?<>Ä צ??>=Ä ??ת:=Ä צ??..Ä ??ת(*Ä צ??*)Ä ??ת(.Ä צ??.)Ä ??ת?ڿǃڿۿǃٓ,ÍٓH ظIIH:Aܪ?ǃH#H ^ptHFNB\  (n0&Z,?ڿǃ?<>Ä צ??>=Ä ??ת:=Ä צ??..Ä ??ת(*Ä צ??*)Ä ??ת(.Ä צ??.)Ä ??ת?ڿǃڿۿǃٓ,Íʀ̀ʀʀÍʀˡCH ʀIIH_  *áa?ǃٓ,ÍٓH ظIIH?ڿǃÍߡH#F?ƀ?ǃ̀ʀX̀ʀ1ƀ̀ƀǃƀƀDŽƀʀCCCšCCƀƀ-̀Cʀ̀ʀGF FˍF˄!á%FFF' c ڪFצFF.ˡ!á%*!~ōتHߓޟˡ*ˡ-G<ˡ#GšGGEEGD* Dˍ*  ڪ"FFáGǃ"FFáwצ GšG Gצ GáGš@G*ˡ7G<á GG!GšGGƀƀáDG Gá%FFFá*GGá%FFFáGGG,GGá%FFFáGGGFت*"DDá*Gǃ*"DDás ײGšGצ Gצ GáGš7G צUNTIL צUSES VAR׮ VARAVAIL׮ צ VARDISPOSE VARNEW׮ צWAIT WHILE׮ WITH׮ צ WORDSTREAM WPROTECT׮ צWRITE צWRITELN צ???p ڪFHEN׮ צTIME TO׮ צ TREESEARCH TRUE׮ צTRUNC צTYPE צUNIT UNPACK׮ צ UNPROTECT צUNITBUSY UNITCLEAR׮ UNITREAD׮ צ UNITSTATUS UNITWAIT׮ צ UNITWRITEצSEEK SEGMENT׮ SEMAPHORE׮ SEMINIT׮ SEPARATE׮ צSET צSIGNAL SIN׮ SINGLE׮ צSIZEOF SQR׮ SQRT׮ צSTART צSTR צSTRING SUCC׮ צTAN צTEXT T  2azȄaAšٛٛ  2٪  iة"iiiihء  iة"iiiih تfPgfgȡ ff(B ڳoڳTצ*Printing has Paused; Press to Continue ڳ Pascal source code file to a printer in a צ@very "pretty" manner. I.e., a header, trailer, and line numbers @are printed. Optionally, Pascal keywords can be highlighted. צ --- NOTE --- kkצ+Optional keyword list can be kept in file------------- kkצPascal Pretty Printer Utility k1.04"kצ [$k1987(kצ])k kk Written by kDavid T. Craigk צ@---------------------------------------------------------------- @This program prints aqop?h n %ȡ ١4إ%צ ئ<<< F I N I S >>> إ%b צ@---------------------------------------------------Ɓ9ǹqƀ́9Ɓ9< Ɓ9qƁ9צ > Ɓ9צPage - Ɓ9ƀƁ9qתpo File - ƀ́9pʁ9ȡ+q́:Ɓ:qƁ:צ Ɓ:ppq́9Ɓ9צFile - Ɓ9 Ɓ9qƁ9ƀƁ9kƀjjƀЪk̀ʀĄʀ;Ȅ٢ʀϚY` ȡ " ȡ = , ڪ٨opoƀƀɡ%ƀ́9Ɓ9צ0Ɓ9ƀiƀЪk̀ʀĄʀȄB٢ʀϚkƀiiƀЪk̀ʀĄʀ;Ȅ٢ʀϚצ:iiצ:jkƀiƀЪk̀ʀĄʀȄ}٢ʀϚkƀijiƀЪk̀ʀĄʀ;ȄB٢ʀʀ ȄI٢ʀϚkƀjjƀЪk̀ʀǭʀȄʀϚ-`FڪŚ šצ Ś:hhȚh̀ʀĄʀȄ٢ʀϚ٢٢:ikDECׯ hhڪŚ šצ Ś-hhÚצ-ikƀiƀЪk̀ʀʀȄ٢ʀϚiצ-jkƀijiƀЪkÚck̀ʀ 0 ooo oǭR~ $ڪhצJANhFEBׯhצMARhAPRׯhצMAYhwJUNׯhfצJULhUAUGׯhDצSEP h3OCTׯ h"צNOV ho-oooo oצ-oǭȄ 0 ooo o oȄ 0 ooo oצ:o;Ȅ 0 ooo o:o;Ȅ% 8٨צ۹ צJAN צFEB צMAR צAPR צMAY~ צJUNr צJULf צAUGZ צSEPN צOCTB צNOV6 צDEC* zpf\RH>4* צ???Ȅ 0 ooo áŚ{-k-+ÍŚNš=iiiij i0jikjjjS ڢڢڢڢڢ "?ٿɡǹšٛ ɡ" 4۪išjjjijÂijái# >  ـۛ0   áڡ ۛ- 3N۪j  צ š צ / ٪צ *** ERROR #  צ []\ šÄ ( š8š)ڛáš 1 J "+kצ.D3/PPKeyWords.TEXT>kצ"?k kkThe current date and time is kk צ:Initializing keyword tokens & loading external keywords... צ.D3/PPKeyWords.TEXT á!ˡInitializing program áb%( Have a good day )תB(dˡצTerminating program צThat's all, Folks...X.á p.TEXTg delay (in 1/10 seconds) [ ] ? ׷~жѡĶ ɄѶѓOצ*** Warning - צ'Ending delay is invalid or out of rangeѲׯצфЫ[ ] ? ׷|жѡĶ ɄѶѓMצ*** Warning - צ%Page delay is invalid or out of rangeѲׯצфЫ  5ѶצEndin] ? ׷|жѡĶ ɄѶѓMצ*** Warning - צ%Line delay is invalid or out of rangeѲׯצфЫ  4ѶצPage delay (in 1/10 seconds) or out of rangeѲצ׷фЫ2%Perform comment commands (Y/N) [Y] ? צYòyÍn3ѶצLine delay (in 1/10 seconds) [ Ѳצ׷фЫ1ѶצPage line width (in inches) [ צ] ? צzжѡŶ$ɄѶѓM*** Warning - %Page width is invalidׯצфЫ 0ѶצPage line count [ צ] ? צ|жѡŶDŽɄѶѓM*** Warning - %Line count is invalid or out of range׷фЫ/ѶצStarting line number [ ] ? ׷tжѡ ŸѶѓN*** Warning - &Line number is invalid or out of rangeѾYòyÍn.ѶצStarting page number [ ] ? ׷qжѡ ŸѶѓK*** Warning - #Page number invalid or out of rangeѲצ? צYòyÍf,Slash the zeros (Y/N) [Y] ? ׯYòyÍd-#Italic Pascal comments (Y/N) [Y] ? צ** Warning - %Pitch size is invalid or out of rangeѲצ׷фЫ*Fanfold paper (Y/N) [Y] ? ׯYòyÍb+Number each line (Y/N) [Y] ilt-in clock !H(Trailer phrase ? צ%ǭH)ѶצFont pitch size [ צ] ? צzжѡŶ2ɄѶѓM*e,Bold,Italic) [Bold] ? צ! ѹ ѲBǶѲצ׷фI;5/BU(  "$&?'-*** Note - Your system has a buY˲y˄h%1Keyword state (Unchanged,Capitalized,Lowercased) צ[Capitalized] ? צCDzšUCL&/Keyword style (Underliná#.TEXTǹ8.TEXTٕˡ!.TEXTǭ!ڪiƂi"hhá ii @"Highlight keywords (Y/N) [Y] ? צ 6fH%&'()*+,-.~/z0v1r2n3j4f5b6^$OMKIGECA?=;97531/-#*** Warning - Invalid option number $Current options: [ 1] Keywords :  Unhighlightedצ Highlighted [ 2] Keyword state : T UnchangedGצ Capitalized* Lowercased\C( [ 3] Keyword Font sN<šn N׷ N@G ˍڍڡ+צ *** Printing stopped by user *** á;nVY[ 9Total pages printed =  צTotal lines printed =  n  n  n : ړGǃG؞"áFá;:ټFFHHn>nn[nH n] ná n 3LMGG(Í?Gá> nƀ aG-GɄGÍ nƀ AGá nƀ -צ%INVALID TOKEN RETURNED BY TS_GetToken ʀš <تFFׯ;:צ(@GH٢LMNצneǶGöÄG)ö(Ä  eeǃeHeŶn nġ'^ö ˄ תת?۪ǃ̀=ʀȡƀHGƀHGGG,Ʉ%ʶ(Ä Ŷn n}=n HGHDzn Göō; N>GöG(ÍGá nǶצHGeeeH šGGnGF:Fȡn زnn , D;צǩá nHGeeeHeǶGöÄG)öListing file [.PRINTER] [.TEXTצ] ?  צצ.PRINTERǹ!  ũb --- NOTE --- צ6Please insert the next sheet of paper & press צc*Are you sure you wish to QUIT (Y/N) [N] ? ׯYy?#*7!"ܓSצ*** Warning - צ)Your file was not found; please try again** Warning - Non-numeric string foundצǹf$ׯ#9*** NOTE - Directory catalog is NOT currently implementedT7(Source file (? = Options, * = Catalog) [.TEXTצ] ? ] Line delay (.1 sec) :   [17] Page delay (.1 sec) :  צ [18] End delay (.1 sec) :  'Enter number of the option to change ? צRefe?&* [12] Starting line no. :   [13] Page line count :  צ [14] Page inch width :   [15] Do comment commands : TRUEFALSEצ [16צFALSE [ 9] Slashed zeros : TRUEFALSEצ [10] Italic comments : áצTRUEצFALSE [11] Starting page no. :  צ "%" [ 6] Font pitch size :  צ [ 7] Paper type : צFanfold Single sheetsצ [ 8] Number lines : צTRUEtyle : I Underline;צBold%צItalic P7# [ 4] Current date : צSystem clock installed []צ [ 5] Trailer phrase :  צStarting clock time =  צEnding clock time = Aƀ۪ڪ٨zƃnƅƁGƃm̅ƅPreparing to print file "ƅƀƅצ" to "ƅƅ" ...ƅ ƅ̅ƁGƀ؞"ˡE̅ƅOpening file "ƅƀƅ" failedƅ ƃn؞"ˡD̅ƅצOpening file "ƅƅ" failedƅ --- N BEGIN { ----- print_expression_string ----- } e_string := ''; { Empty string } FOR ch_index := 1 TO LENGTH(expr_string) DO BEGIN IF (expr_string[ch_index] IN ['1'..'9']) THEN BEGIN { Digit foaluate_expression_value ----- } { ---------------------------------------------------------------------- } PROCEDURE print_expression_string; VAR ch_index : INTEGER; e_string : STRING[63]; handle_number_token ELSE { Operator found } handle_operator_token; END; UNTIL (ch_posn > expr_length); END; END; END; { ----- ev0; ch_posn := 1; expstk_ptr := 0; REPEAT BEGIN IF number_found THEN { Digit found so get remaining number digits } str_to_value(expr_string,result,conversion_OK); END ELSE BEGIN expr_length := LENGTH(expr_string); IF (expr_length > 0) THEN BEGIN result := ----------------------------------- } BEGIN { ----- evaluate_expression_value ----- } IF (POS('+',expr_string) = 0) AND (POS('-',expr_string) = 0) THEN BEGIN ch_posn := ch_posn + 1; END ELSE { An invalid operator should NEVER appear } WRITELN('*** INVALID OPERATOR FOUND ***'); END; { ----- handle_operator_token ----- } { -----------------------------------tring[ch_posn] = '+') OR (expr_string[ch_posn] = '-') THEN BEGIN IF (expr_string[ch_posn] = '+') THEN push_value(ORD('+'),stk_full) ELSE push_value(ORD('-'),stk_full); END; END; { ----- handle_number_token ----- } { ---------------------------------------------------------------------- } PROCEDURE handle_operator_token; BEGIN { ----- handle_operator_token ----- } IF (expr_s8Aƅ" failedƅ ƃn؞"ˡC̅ƅClosing file "ƅƀƅ" failedƅ ƁG؞"ˡC̅ƅClosing file "ƅƀƅ" failedƅ áAƃnƁGoF T8t*P)QQá-SR RSQ8RQˍ* Wn. D  4  Tjvd8B !"l#T# #J$H% ((*J*r*-n,0. 1412p222>3l33445556467ƅ" failedƅ ƃn؞"ˡC̅ƅClosing file "ƅƀƅ" failedƅ ƁG؞"ˡC̅ƅClosing file "ƅƀƅ" failedƅ áAƃnƁGoF T8t*PALLED * צ6****************************************************** !Please press to continue ƅ̅ƅPrinting file "ƅƀƅצ" ...ƅ ƅ9šˡD̅ƅצPrinting file "ƅƀOTE --- צ'To Quit printing, press the key צ'To Pause printing, press the

key צ'To Continue printing, press the key צ6****************************************************** 6* VERIFY THAT THE PRINTER IS ON & PAPER IS INSTund, so only insert digit into string } e_string := CONCAT(e_string,'?'); e_string[LENGTH(e_string)] := expr_string[ch_index]; END ELSE { Operator found, so pad operator with spaces & insert } BEGIN e_string := CONCAT(e_string,'?'); e_string[LENGTH(e_string)] := ' '; e_string := CONCAT(e_string,'?'); e_string[L END; { ----- Do_ShowTally ----- } { ---------------------------------------------------------------------- | Routine : Do_AscendingOrder | Purpose : Set the tally digit sequence to ascending order | Input : (none) | Output : Global tally (sign_list[8] = 2); { If more matches still exist then proceed to the next match } IF NOT(digit_overflow) THEN increment_sign_list_by_one; END; UNTIL digit_overflow; (sign_list[3] = 2) AND (sign_list[4] = 2) AND (sign_list[5] = 2) AND (sign_list[6] = 2) AND (sign_list[7] = 2) AND ',g_TallyInfo.match); END; END; { Test if all the digit possibilities have been tested } digit_overflow := (sign_list[1] = 2) AND (sign_list[2] = 2) AND { Print the match counter & matched expression } match_count := match_count + 1; WRITE(' [',match_count:4,'] '); print_expression_string; WRITELN(' = { Make certain current match is different from last match } IF (expr_string <> old_expr_str) THEN BEGIN old_expr_str := expr_string; n_string; { Setup string expression } evaluate_expression_value(expr_value); { Evaluate the expression } { Test if a match has occured } IF (expr_value = g_TallyInfo.match) THEN BEGIN expr_str := ''; init_sign_list_to_zero; { Cycle through each of the possibilities searching for a match } REPEAT BEGIN setup_opcode_list; { Setup opcode list } setup_expressio { Start the sequencing } WRITELN; WRITELN('Searching for matches of your number ', 0'(sit back and relax) ...'); WRITELN; { Initialize some counters and other miscellania } match_count := 0; old_),1); str_to_value(expr_string,g_TallyInfo.match,conversion_OK); IF NOT(conversion_OK) THEN WRITELN('*** NOTICE --- Please type a number here'); END; UNTIL conversion_OK; WRITE('What value do you wish to match [100] ? '); READLN(expr_string); IF (expr_string = '') THEN expr_string := '100'; WHILE (POS(' ',expr_string) > 0) DO DELETE(expr_string,POS(' ',expr_string OF order_Ascending : digit_list := k_AscendingList; order_Descending : digit_list := k_DescendingList; END; { Prompt the user for her match value (default = 100) } WRITELN; REPEAT BEGIN END; { ----- print_expression_string ----- } { ---------------------------------------------------------------------- } BEGIN { ----- Do_ShowTally ----- } { Setup the digit list in the correct order } CASE g_TallyInfo.orderENGTH(e_string)] := expr_string[ch_index]; e_string := CONCAT(e_string,'?'); e_string[LENGTH(e_string)] := ' '; END; END; WRITE(e_string:33); order altered ---------------------------------------------------------------------- } PROCEDURE Do_AscendingOrder; BEGIN { ----- Do_AscendingOrder ----- } WRITELN('Digits are now in an ascending order'); g_TallyInfo.order := order_Ascending; END; { ----- Do_AscendingOrder ----- } { ---------------------------------------------------------------------- | Routine : Do_DescendingOrder | Purpose : Set the tally digit sequence to descending order | Input : (none) تOP!NINE TO ONE EQUALS 100 - Version צ1.00צNot (c) צ October 1987צ by צ David Craigצ>This program displays the tallies for an old numerical problemAwhere@dNINETOON [] [] F I N I S [] [] [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } " } END; UNTIL g_UserIsDone; { Bye ... } Aufwiedersehen; END. { ----- Nine_to_One_equals_100 ----- } { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] { Prompt the user for commands until she gets bored } REPEAT BEGIN Fetch_UserCommand(g_UserCommand,g_UserIsDone); { Get command } IF NOT(g_UserIsDone) THEN Execute_UserCommand(g_UserCommand); { Do command [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } BEGIN { ----- Nine_to_One_equals_100 ----- } { Introduce yourself to the user } Introduction; { Initialize yourself } Initialize; [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] [] [] T H E M A I N E V E N T [] [] serCommand ----- } CASE user_command OF uc_ShowTally : Do_ShowTally; us_AscendingOrder : Do_AscendingOrder; us_DescendingOrder : Do_DescendingOrder; END; END; { ----- Execute_UserCommand ----- } { [][][][][] WRITELN('Digits are now in a descending order'); g_TallyInfo.order := order_Descending; END; { ----- Do_DescendingOrder ----- } { ---------------------------------------------------------------------- } BEGIN { ----- Execute_U | Output : Global tally order altered ---------------------------------------------------------------------- } PROCEDURE Do_DescendingOrder; BEGIN { ----- Do_DescendingOrder ----- } the mathematical signs of addition & subtraction are placed7as desired between the ordered digits 1,2,3,4,5,6,7,8,9"so that the expression equals 100.צ;For example, the sequence 1 + 2 + 34 - 5 + 67 - 8 + 9 = 100 That's all, Folks ...4צ COMMAND: 4S)howTally A)scendingOrder D)escendingOrder Q)UIT ? ڹ^צ&Are you sure you wish to QUIT (Y/N) ? YyÍ% C.D3/NINE2ONE $ X.D3/NINE2ONE %% ÄÄÄÄÄÄÄ00 02b t$Digits are now in an ascending order@$Digits are now in a descending order@ع  $ꓡ" .\`0vZL R : t Z ,wo,,צ [, צ] צ =  ÄÄÄÄÄÄÄ00 02b t$Digits are now in an ascending order@$Digits are now in a descending order@ع hing for matches of your number (sit back and relax) ...,צ (( wo,,צ [, צ] צ =  23456789ת  987654321ת +(What value do you wish to match [100] ? ׯ צ100צ š 1 18צ(*** NOTICE --- Please type a number here1צ%Searcš<dצ?""ȡؾ)##?#?@#?ؾm##?#צ?@#? ##?#?@#?ؾ##?#צ?@#? ! $ 1ALID OPERAND ***!0 @+ò-Í5+á+-.*** INVALID OPERATOR FOUND ***צ+צ-Ä ز1 0š$ȡ/)哶ō 1    +  - _ +     '*** INVɶč6$*** INVALID STACK POINTER [PUSH] ***#ضÚ rɶč6צ$*** INVALID STACK POINTER [PULL] ***زf?? ق+!ق-ق % ײšצ 'k ڪ  侳&0ټ Q n š  ٚ؂š  ٚp ȡD$ &  ,"L Z  ת ȡؾȡ= ٚ؂š  ٚ؂š  ٚ؂š  ٚ؂š  ٚ؂š  ٚpAsf`a  v$(*,.02468:<>@DFJLNPRTVXZ\^`dˡ?  LX š 2GREGORIA تצ *** ERROR: [ צ] Fš%ٛaٛzȄ ٛٛaAá( :šÄ (š)šڛáš&:۪̀ @dFILEDIVI saturdaysundaymondaytuesdayoצ wednesdayPthursday2fridayiL0That's all, Folks ...46N  hp Enter Month (1-12 ) ?  Enter Day (1-31 ) ?  ,The date is not good ! The day is saturdaysundaymondaytuesdayoצ wednesdayPthursday2fridayiL0That's all, FEnter Year (1752+) ?  Enter Month (1-12 ) ?  Enter Day (1-31 ) ?  ,The date is not good ! The day is .+(%"ǤȄkȄlȄ3Ȅ4ǗȄd ߂ނ  #4/*% +(%"׶2Calendar Date to Day utility by David Craig - 1988d˄ǐÍ$ڨǗō ō ō- צ is a Leap YearܹT  b  Q L G B = 8 3 . ) $  [L=:741  šצ  áŚ-̀-+ÍŚYšÈʀ̀ʀʀ ʀ0̀ʀʀʀ̀ʀb ئת   ȡ$צ   ـۛ0   áڡ ۛ- 4n TEXT FILE DIVIDE Utility צ1.00צNot (C) Copyright צ6-Feb-88צ by צ David Craig'APPLE3AS ʄg [ƅ ]Ƃʆog ʆoˡCʆŏpƆpWriting to file "ƆpƆ=tƆpצ" failed|ƆpgƂgs- R6 ꓡ6 &&2:f~Z V, f $  ^ $Ɔpc Writing to file "Ɔ=צ" ... ƂƆ="̆oʆoáƅgƅ9g"̆oʆoáZƅƅƅ9ƅƄ ̄Ƃƅ9Ƃ"̆oʆoʄg [ƅ ]Ƃʆog ʆoˡCʆŏpƆpWriting to file "ƆpƆ=tƆpצ" failed|ƆpgƂgs- R6 ꓡ6 &&2:f~Zp.dƆpƅƆpƄƆpc Writing to file "Ɔ=צ" ... ƂƆ="̆oʆoáƅgƅ9g"̆oʆoáZƅƅƅ9ƅƄ ̄Ƃƅ9Ƃ"̆oʆoˡAʆŏpƆpOpening file "Ɔp5qƆpצ" failedyƆpƄ.DIVתצ.DIVšצ.DIVצ.DIVצ.TEXTš.TEXTצ.TEXT̆<ʆ<̆<ʆ<ƅʆ< ɡ#ƅ̆pƆp0ƆpƅƆpƆ=̆pƆpcƆʀH *** ERROR: צ#Invalid number --- please try againʀ 5٪cتcƂƄgƂƄDividing file "5" into "צ" ...g5"̆oʆoצ.DIVצ] ? c33 3 3cצc    צd  &Enter divided file size (in Kbytes) ? ƀme too long (> c צchars)צc4̀ƀcƀ.TEXThƀc  צ l"c.TEXTšצ.TEXT.TEXTEnter output file [** WARNING: צFile name too long (> c צ chars.תc4̀ƀcƀצ.TEXThƀc  צ.TEXT.TEXTá cצ.TEXTšk *** WARNING: צFile na Are you sure you wish to QUIT (Y/N) [N] ? ƀƀׯƀNƀYƀy?צ????ׯתc .á'צ  צ.TEXTácצ.TEXTšl *ׯNYyתc 2??? CATALOG FEATURE NOT IMPLEMENENTED FOR A/// ???JEnter TEXT file to divide [צ.TEXT] ? c  cצi, 66 B  *** WARNING: File "צ " not foundئתcP  *** WARNING: File "צ" already exists.( Overwrite it (Y/N) [N] ? 8This program divides large TEXT files into smaller files6with the size of the smaller files under user control.*That's all, Folks ...4 ڪc6Ƃ\6"̂]ʂ]@dAsmFormatter : Not (c) 1986 by David Craig*áƀƀƀƀƀƀƀɡ#ƀ̀ƀצ#ƀƀƀƀɡ#ƀ̀ƀצ#ƀƀƀƀƀƀƀƀƀƀƀƀƀƀƀƀƀƀƀVƀ  ˍצ' Count opcode frequencies (Y/N) [Y] ? NÄ؞"ˡ2á' [ צ] á.؞"á/N) [Y] ? NÄצ' Remove page headers (Y/N) [Y] ? NÄצ' Uppercase opcodes (Y/N) [Y] ? NÄצ& Overwrite it (Y/N) [N] ? ƀƀƀƀá٦תƀYƀy˄צšj Formatting Options:צ' Remove blank lines (YƁ.FORMƁ.á .FORMá'́ƁƁ.FORMƁFצ.FORM.FORMˡ%́ƁƁ.FORMƁצ *** WARNING: File "" already exists.צōڪ.TEXTšAצ.TEXT.TEXTá.TEXTצ.TEXTצEnter output file [צ]/[צ.FORM] ? á(́Ɓ ? Ú.á .TEXTá'́ƁƁ.TEXTƁFצ.TEXT.TEXTˡ%́ƁƁ.TEXTƁG*** NOTE: File "" was not foundy one procedure or function. If a listing has multipleצ9 routines then this program can output invalid data.8nThat's all, Folks ...4Enter Assembler listing file [.TEXTצ]tches are filled with the correct values. Once patched, ٨ ɡ   ˍ/ D ت $BP.CACHE؞"$š ۢ؞"2ˡhšܢ؞"áBܢ؞"á$áȡ ڢٚ | ڪƀƂƀ"̂ʂá ƀ̀̀ʀƀPNšپaپzȄ پaA%2šپAپZȄ پAa%2  Í & Ä áwá,צ (1 back-patch was found)?צ ( צ back-patches were found)5c, ۨڨ צ????????ת        xɡ5# Back-patches are already sorted !  V ˡV ˡoe2á' [ צ] á. V ˡ V O^4"á員H/ /צ%( no opcodes were found in the file )/Q/ /צProgram opcode usage: /d8 /צ %//؞".(AZȄazȄ" /Average frequency = / /á//צ /Unused opcodes:/؞"ˡ}táCá//צ //צ ؞"8ˍá// ȡ/*/؞"8ˍáá// /צMinimum frequency = / // /צMaximum frequency = / /še //צ /צ // : /t tá/ m /tá/צ M /צ | ؞"áKšF t d   t//؞"ˡtŲtɄ ttš t8áKš>dK tštצSED/צSEI0צSTA1צSTX2צSTY3צTAX4צTAY5צTSX6צTXA7צTXS8צTYA8ȡt//6502 OPCODE STATIC FREQUENCIESפצLDAצLDX צLDY!צLSR"צNOP#צORA$צPHA%צPHP&צPLA'צPLP(צROL)צROR*צRTI+צRTS,צSBC-צSEC.צCLCצCLDצCLIצCLVצCMPצCPXצCPYצDECצDEXצDEYצEORצINCצINXצINYצJMPצJSRˍˍ"צADCצANDצASLצBCCצBCSצBEQצBITצBMI צBNE צBPL צBRK צBVC צBVS { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] "[] [] "[] APPLE /// DIGITAL CLOCK [] "[] time_5; ('6' : time_unit := time_6; ('7' : time_unit := time_7; ('8' : time_unit := time_8; ('9' : time_unit := time_9; (':' : time_unit := time_Colon; ( (OTHERWISE time_unit := time_Blank; &END; & &char_bitmap := gv_AlphabetBM[time_unit]; & &t; &char_bitmap : gt_CharBitMap; &row : INTEGER; & $BEGIN &CASE the_char OF & '0' : time_unit := time_0; ('1' : time_unit := time_1; ('2' : time_unit := time_2; ('3' : time_unit := time_3; ('4' : time_unit := time_4; ('5' : time_unit :=$END;  { ------------------------------------------------------------------- }  { draw a bitmap character image on the screen at a specific location } "PROCEDURE draw_bm_character (the_char : CHAR; x,y : INTEGER); " $VAR &time_unit : gt_TimeUni { center a phrase on the screen at a specific screen row } "PROCEDURE center_phrase (phrase : gt_Phrase; where_y : INTEGER); " $CONST &k_screen_width = 80; " $BEGIN &GOTOXY( (k_screen_width - LENGTH(phrase)) DIV 2 , where_y ); &WRITE(phrase); } $gv_TheTime : gt_TimeString; { current system time } $gv_UserIsDone : BOOLEAN; { user termination flag } $gv_AlphabetBM : gt_AlphabetBM; { entire character bitmaps }  { ------------------------------------------------------------------- } ime_8,time_9, 5time_Colon,time_Blank); $ ${ character bitmap collection } $ $gt_AlphabetBM = ARRAY [gt_TimeUnit] OF gt_CharBitMap; $ ${ generic phrase } $ $gt_Phrase = STRING[79]; $ "VAR $gv_LastTime : gt_TimeString; { last system time${ larger bitmap (e.g., a size of 32 x 32 could work well) } $ $gt_CharBitMap = {PACKED for graphics} ARRAY [0..7,0..8] OF BOOLEAN; $ ${ allowable time elements } $ $gt_TimeUnit = (time_0,time_1,time_2,time_3,time_4, 5time_5,time_6,time_7,tives }  "{$IOCHECK-} {$VARSTRING-} {$RANGECHECK-} {$GOTO+} " "TYPE ${ system time string } $ $gt_TimeString = STRING[6]; $ ${ single character bitmap (8 x 9 pixels) } $ ${ Note: If graphical output is used, then I suggest you use a } [] "[] [] "[][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } " PROGRAM Digital_Clock; "USES AppleStuff; { special Apple /// system routines }  "{ Apple /// compiler direct [] "[] graphical images instead of text letters. [] "[] [] "[] Note.........: This program has been placed into the [] "[] Public Domain by the author. "[] To stop the program press any key. [] "[] [] "[] With very little modification the output [] "[] of this program can be performed using een a [] "[] large digital clock which shows the [] "[] current Apple /// time. [] "[] [] [] "[] Language.....: Apple /// Pascal 1.1 [] "[] Computer.....: Apple /// [] "[] [] "[] Purpose......: This program displays on the scr [] "[] Author.......: David Craig [] "[] Address......: 736 Edgewater, Wichita KS 67230 [] "[] Date.........: 1988 [] "[] { Note: For maximum speed of character output, the following } &{ loop could be made into a long series of statements } &{ which replace the looping structure. } & &FOR row := 7 DOWNTO 0 DO (BEGIN *GOTOXY(x , y + row); * *IF char_bitmap[row,0] THEN WRITE(CHR(127)) ELSE WRITE(' '); *IF char_bitmap[row,1] THEN WRITE(CHR(127)) ELSE WRITE(' '); *IF char_bitmap[row,2] THEN WRITE(CHR(127)) ELSE WRITE(' '); *IF char_bitmap[row,3] THEN WRITE(CHR(127)) ELSE WRITE(' '); *IF r_bm[7] := ' XXXXXXX '; ( (setup_char_bitmap(char_bm,time_5); { setup the "5" bitmap } ( (char_bm[0] := ' XXXXXXX '; (char_bm[1] := 'X X'; (char_bm[2] := 'X '; (char_bm[3] := 'X '; (char_bm[4] := 'XXXXXXXX '; (char_bm[5] := 'X ------ } $ $PROCEDURE init_5_to_9; $ &BEGIN (char_bm[0] := 'XXXXXXXXX'; (char_bm[1] := 'X '; (char_bm[2] := 'X '; (char_bm[3] := 'XXXXXXXX '; (char_bm[4] := ' X'; (char_bm[5] := ' X'; (char_bm[6] := 'X X'; (cha(char_bm[4] := ' X X '; (char_bm[5] := ' XXXXXXXX'; (char_bm[6] := ' X '; (char_bm[7] := ' X '; ( (setup_char_bitmap(char_bm,time_4); { setup the "4" bitmap } &END;   { ------------------------------------------------------------- X'; (char_bm[6] := 'X X'; (char_bm[7] := ' XXXXXXX '; ( (setup_char_bitmap(char_bm,time_3); { setup the "3" bitmap } ( (char_bm[0] := ' XX '; (char_bm[1] := ' X X '; (char_bm[2] := ' X X '; (char_bm[3] := ' X X '; [7] := 'XXXXXXXXX'; ( (setup_char_bitmap(char_bm,time_2); { setup the "2" bitmap } ( (char_bm[0] := ' XXXXXXX '; (char_bm[1] := 'X X'; (char_bm[2] := ' X'; (char_bm[3] := ' XXXX '; (char_bm[4] := ' X'; (char_bm[5] := ' har_bm,time_1); { setup the "1" bitmap } ( (char_bm[0] := ' XXXXXXX '; (char_bm[1] := 'X X'; (char_bm[2] := ' X'; (char_bm[3] := ' XX '; (char_bm[4] := ' XXX '; (char_bm[5] := ' XX '; (char_bm[6] := 'X '; (char_bm(char_bm[0] := ' X '; (char_bm[1] := ' XX '; (char_bm[2] := ' X '; (char_bm[3] := ' X '; (char_bm[4] := ' X '; (char_bm[5] := ' X '; (char_bm[6] := ' X '; (char_bm[7] := ' XXXXX '; ( (setup_char_bitmap(c := 'X X'; (char_bm[3] := 'X X'; (char_bm[4] := 'X X'; (char_bm[5] := 'X X'; (char_bm[6] := 'X X'; (char_bm[7] := ' XXXXXXX '; ( (setup_char_bitmap(char_bm,time_0); { setup the "0" bitmap } (   { ------------------------------------------------------------------- } { initialize several character bitmaps to their respective values } & $PROCEDURE init_0_to_4; % &BEGIN (char_bm[0] := ' XXXXXXX '; (char_bm[1] := 'X X'; (char_bm[2]4IF bm_str[col+1] = ' ' THEN 6gv_AlphabetBM[the_time_unit][row,col] := FALSE 4ELSE 6gv_AlphabetBM[the_time_unit][row,col] := TRUE; 2END; .END ,ELSE .BEGIN 0FOR col := 0 TO 8 DO 2gv_AlphabetBM[the_time_unit][row,col] := FALSE; .END; *END; &END;Athe_time_unit : gt_TimeUnit); $ &VAR (row : INTEGER; (col : INTEGER; (bm_str : STRING[9]; $ &BEGIN (FOR row := 0 TO 7 DO *BEGIN ,IF LENGTH(the_char_bm[row]) = 9 THEN .BEGIN 0FOR col := 0 TO 8 DO 2BEGIN 4bm_str := the_char_bm[row]; 4 ING[9]; $ $VAR &char_bm : t_CharBitMap;   { ------------------------------------------------------------------- } { setup the actual bitmap image in a character bitmap structure } $PROCEDURE setup_char_bitmap (the_char_bm : t_CharBitMap; map[row,8] THEN WRITE(CHR(127)) ELSE WRITE(' '); (END; & $END;   { ------------------------------------------------------------------- }  { initialize the character bitmaps }  "PROCEDURE initialize; " $TYPE &t_CharBitMap = ARRAY [0..7] OF STRchar_bitmap[row,4] THEN WRITE(CHR(127)) ELSE WRITE(' '); *IF char_bitmap[row,5] THEN WRITE(CHR(127)) ELSE WRITE(' '); *IF char_bitmap[row,6] THEN WRITE(CHR(127)) ELSE WRITE(' '); *IF char_bitmap[row,7] THEN WRITE(CHR(127)) ELSE WRITE(' '); *IF char_bit X'; (char_bm[6] := 'X X'; (char_bm[7] := ' XXXXXXX '; ( (setup_char_bitmap(char_bm,time_6); { setup the "6" bitmap } ( (char_bm[0] := 'XXXXXXXXX'; (char_bm[1] := 'X X'; (char_bm[2] := ' X'; (char_bm[3] := ' X '; (char_bm[4] := ' X '; (char_bm[5] := ' X '; (char_bm[6] := ' X '; (char_bm[7] := ' X '; ( (setup_char_bitmap(char_bm,time_7); { setup the "7" bitmap } ( (char_bm[0] := ' XXXXXXX '; (char_bm[1] := 'X X'; (char_bm[2] :$ "BEGIN $ ${ initialize and introduce the program } $ $initialize; $ ${ display the current system time as a digital readout and } ${ wait for the user to press any key for quitting } $ $REPEAT &BEGIN ({ read the current system time }----------------------------------- } { THE MAIN EVENT - initialize the program, display the current system } { time as a large digital readout, wait for the user } { to press a key, and gracefully depart when done. } &IF last_time[3] <> the_time[3] THEN draw_bm_char(the_time[3],30,8); &IF last_time[2] <> the_time[2] THEN draw_bm_char(the_time[2],10,8); &IF last_time[1] <> the_time[1] THEN draw_bm_char(the_time[1], 0,8); $END;   { --------------------------------he_time : gt_TimeString); & $BEGIN &IF last_time[6] <> the_time[6] THEN draw_bm_char(the_time[6],70,8); &IF last_time[5] <> the_time[5] THEN draw_bm_char(the_time[5],60,8); &IF last_time[4] <> the_time[4] THEN draw_bm_char(the_time[4],40,8); ------ } " { display the current time on the screen as a set of large digital } { images such that only time elements that have changed will be } { redisplayed } "PROCEDURE show_time (last_time , t---------------------------------------- } { say some parting words to the user } " "PROCEDURE farewell; " $BEGIN ¢er_phrase('That''s all, Folks ...',23); { say bye ... } $END;   { -------------------------------------------------------------&{ display the clock's ":" characters since these are permanent } & &draw_bm_char(':' , (80 DIV 2) - 2 * (9+1) , (24 DIV 2) - (8 DIV 2)); &draw_bm_char(':' , (80 DIV 2) + 1 * (9+1) , (24 DIV 2) - (8 DIV 2)); & $END;   { --------------------------- readout characters } &init_5_to_9; &init_Colon_and_Blank; & &{ welcome the user to this entertaining collection of bits } & ¢er_phrase('The Apple /// Presents the Time ...',0); & map } &END;   { ------------------------------------------------------------------- } & $BEGIN &WRITE(CHR(28)); { clear the Apple /// console screen } & &gv_LastTime := '??????'; { must have a length of 6 } & &init_0_to_4; { initialize the clock1] := ' '; (char_bm[2] := ' '; (char_bm[3] := ' '; (char_bm[4] := ' '; (char_bm[5] := ' '; (char_bm[6] := ' '; (char_bm[7] := ' '; ( (setup_char_bitmap(char_bm,time_Blank); { setup the " " bit(char_bm[3] := ' XXX '; (char_bm[4] := ' '; (char_bm[5] := ' XXX '; (char_bm[6] := ' XXX '; (char_bm[7] := ' '; ( (setup_char_bitmap(char_bm,time_Colon); { setup the ":" bitmap } ( (char_bm[0] := ' '; (char_bm["9" bitmap } &END;   { ------------------------------------------------------------------- } $ $PROCEDURE init_Colon_and_Blank; $ &BEGIN (char_bm[0] := ' '; (char_bm[1] := ' '; (char_bm[2] := ' XXX '; (char_bm[1] := 'X X'; (char_bm[2] := 'X X'; (char_bm[3] := ' XXXXXXXX'; (char_bm[4] := ' X'; (char_bm[5] := ' X'; (char_bm[6] := 'X X'; (char_bm[7] := ' XXXXXXX '; ( (setup_char_bitmap(char_bm,time_9); { setup the = 'X X'; (char_bm[3] := ' XXXXXXX '; (char_bm[4] := 'X X'; (char_bm[5] := 'X X'; (char_bm[6] := 'X X'; (char_bm[7] := ' XXXXXXX '; ( (setup_char_bitmap(char_bm,time_8); { setup the "8" bitmap } ( (char_bm[0] := ' XXXXXXX '; ( (TimeOfDay(gv_TheTime); ( ({ test if the current time differs from the last read time } ({ and if so adjust the display as appropriate } ( (IF gv_TheTime <> gv_LastTime THEN *BEGIN ,{ display the new time } , * show_time(gv_LastTime,gv_TheTime); , ,{ update the last time to the current time } , ,gv_LastTime := gv_TheTime; *END; ( ({ test if the user has had enough } ( (gv_UserIsDone := KeyPress; &END; $UNTIL gv_UserIsDone; $ ${ stop when the userXXXXXXX צ X צ X צ X X צ XXXXXXX צ XXXXXXX צ X X צ X צ X צ XXXXXXXX צ X X צ X X צ XXXXXXX צ XX צ X X צ X X צ X X צ X X צ XXXXXXXX צ X צ X Fצ XXXXXXXXX צ X צ X צ X XX צ XXX צ XX צ X צ XXXXXXXXX צ XXXXXXX צ X X צ X צ XXXX צ X צ X צ X X צ XXXXXXX צ XXXXXXX צ X צ XX צ X צ X צ X צ X צ X צ XXXXX צ XXXXXXX צ X X צ X צ á ؤH+ , ؤH+ ,,,$,3,3ȡ ؤH+ ,,,++,zbצ XXXXXXX צ X X צ X X צ X X צ X X צ X X צ X X   M   M   M   M   M   MM* ٨(+2+2ȡ+ áL,3,3ȡ=-+ -,٪OPP"ڹ7SNID?:50+ & !0:?<9630-*'$!  ۤHHMNMNġMM   M   M   M @n DIGITALC has pressed any key } $ ${ say some parting words to the user } $ $farewell; $ "END. " @{ <<< FINIS >>> }  צ XXXXXXXXX צ X X צ X צ X צ X צ X צ X צ X צ XXXXXXX צ X X צ X X צ XXXXXXX צ X X צ X X צ X X צ XXXXXXX צ XXXXXXX צ X X צ X X צ XXXXXXXX צ X צ X צ X X צ XXXXXXX   [] [] [] PURPOSE : This program divides very large TEXT files into [] [] smaller TEXT files on a line by line basis. [] [] The size of the divided f [] [] COMPUTER : Apple /// [] "[] [] [] -------------------------------------------------------------- [] [] [] AUTHOR : David Craig (736 Edgewater, Wichita KS 67230) [] [] DATE : 1987 [] [] LANGUAGE : Apple /// Pascal 1.1 V I D E [] [] ----------------------------------------------- [] [] [] [] Version 1.00 [] [] { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] [] [] ----------------------------------------------- [] [] F I L E D I O^rتˡFˡ<ˡ(ˡˡ ˡ /    63BHrd   צ צ צ צ צ  Tצ??????#The Apple /// Presents the Time ...:P :P PrצThat's all, Folks ...$ ٪Fצ צ צ XXX צ XXX צ צ XXX צ XXX צ  צ צ צ צ iles is determined by [] [] the user. [] [] [] [] The main use for this program concerns the [] [] editing of files which are too large for [] [] editors or the copying of large files to various [] [] small diskettes. [] [] | Input : err_code - Error code | err_msg - Error message | Output : (none) -------------------------------------------------------------------- } PROCEDURE ShowError(err_code : t_Error; err_msg : t_String); BEGIN { ----- Show [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } { -------------------------------------------------------------------- | Routine : ShowError | Purpose : Display an error code & message { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] [] [] M I N O R R O U T I N E S [] [] * ******************************************************************** } VAR g_UserIsDone : BOOLEAN; { User termination flag } g_InputFile : t_FileName; { User input file name } g_OutputFile : t_FileName; { User output file name } t_String = STRING[255]; { Generic string } t_Error = INTEGER; { Error code } { ******************************************************************** * GLOBAL VARIABLES GLOBAL TYPE DECLARATIONS * ******************************************************************** } TYPE t_FileName = STRING[k_MaxFNLength]; { File name } Code for no error [///] } k_TextSuffix = '.TEXT'; { Text file suffix [///] } k_OutFSuffix = '.DIV'; { Divided file suffix } { ******************************************************************** * '; { Program author } k_PgmVersion = '1.00'; { Version (X.YZ) } k_PgmDate = '6-Feb-88'; { Compilation date (dd-MMM-yy) } k_MaxFNLength = 99; { Maximum file name length [///] } k_NoError = 0; { { ******************************************************************** * GLOBAL CONSTANTS * ******************************************************************** } CONST k_PgmAuthor = 'David Craig COMPILER DIRECTIVES * ******************************************************************** } {$IOCHECK-} { Turn OFF runtime I/O checking } "{$VARSTRING-} { Turn OFF runtime string checking } " [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } PROGRAM File_Divide; { And here's ... } { ******************************************************************** * ced into the Public [] [] Domain by the author, David T. Craig, and as such [] [] it may be used or abused in any manner as others [] [] see fit. [] [] [] [///] which should be altered if the code is to [] [] be run on other systems. [] [] [] [] This program has been pla [] [] -------------------------------------------------------------- [] [] [] [] NOTES : All /// specific code is marked with the phrase [] Error ----- } &WRITE(CHR(7)); { sound the default audio beep (ASCII Bell) } & WRITELN('*** ERROR: [',err_code:1,'] ',err_msg); END; { ----- ShowError ----- } { -------------------------------------------------------------------- | Routine : UpperCasePhrase | Purpose : Uppercase the characters in a phrase | Input : the_phrase - Original phrase | Output : the_phrase - Original phrase uppercased -------------------------------------------------------------------- } PROCEDURE Upper Trim_Trailing(s,' '); REPEAT BEGIN IF (POS(' ',s) > 0) THEN DELETE(s,POS(' ',s),1); END; UNTIL (POS(' ',s) = 0); conv_ok := (LENGTH(s) > 0); IF conv_ok THEN BEGIN nega VAR conv_ok : BOOLEAN) : INTEGER; VAR i : INTEGER; result : INTEGER; negative : BOOLEAN; BEGIN { ----- String_To_Int ----- } result := 0; Trim_Leading (s,' '); g to convert | Output : conv_ok - Conversion OK flag (TRUE -> OK) | If conv_ok = TRUE, then converted integer returned -------------------------------------------------------------------- } FUNCTION String_To_Int( s : t_String; END; END; END; { ----- Trim_Trailing ----- } { -------------------------------------------------------------------- | Routine : String_To_Int | Purpose : Convert a numeric string to an integer | Input : s - Numeric strin DELETE(s,i,1) { Yes, so trim character } ELSE i := 0; { No, so stop } IF (i > 0) THEN i := i - 1; { Point at the next character } THEN BEGIN i := LENGTH(s); { Trim from the end to the start } WHILE (i > 0) DO { Trim until trimming is done } BEGIN IF s[i] = charToTrim THEN { Match found ? } ------- } PROCEDURE Trim_Trailing(VAR s : t_String; charToTrim : CHAR); VAR i : INTEGER; { String index } BEGIN { ----- Trim_Trailing ----- } IF (LENGTH(s) > 0) { Trim only real strings } : Remove specified trailing character from a string | Input : s - String to trim | charToTrim - Character to trim from string | Output : s - Trimmed string ------------------------------------------------------------- WHILE (LENGTH(s) > 0) AND (s[1] = charToTrim) DO DELETE(s,1,1); END; END; { ----- Trim_Leading ----- } { -------------------------------------------------------------------- | Routine : Trim_Trailing | Purpose -------------- } PROCEDURE Trim_Leading(VAR s : t_String; charToTrim : CHAR); BEGIN { ----- Trim_Leading ----- } IF (LENGTH(s) > 0) { Trim only real strings } THEN BEGIN Purpose : Remove specified leading character from a string | Input : s - String to trim | charToTrim - Character to trim from string | Output : s - Trimmed string ------------------------------------------------------ END; ch_index := ch_index - 1; END; UNTIL (ch_index = 0); END; END; { ----- UpperCasePhrase ----- } { -------------------------------------------------------------------- | Routine : Trim_Leading | IF (the_phrase[ch_index] >= 'a') AND (the_phrase[ch_index] <= 'z') THEN BEGIN the_phrase[ch_index] := CHR( ORD(the_phrase[ch_index]) - ORD('a') + ORD('A') ); CasePhrase(VAR the_phrase : t_FileName); VAR ch_index : INTEGER; BEGIN { ----- UpperCasePhrase ----- } ch_index := LENGTH(the_phrase); IF (ch_index > 0) THEN BEGIN REPEAT BEGIN tive := (s[1] = '-'); IF (s[1] = '-') OR (s[1] = '+') THEN DELETE(s,1,1); conv_ok := (LENGTH(s) > 0); IF conv_ok THEN BEGIN IF (LENGTH(s) > 0) THEN BEGIN i := 0; REPEAT BEGIN i := i + 1; conv_ok := (s[i] IN ['0'..'9']); IF conv_ok THEN result := (result * 10) + ORD(s[i]) - ORD( $ NOTES : (none) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ } PROCEDURE Aufwiedersehen; BEGIN { ----- Aufwiedersehen ----- } WRITELN; WRITELN('That''s all, Folks ...'); END; { ----- Aufwiedersehen --control.'); END; { ----- Introduction ----- } { $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ $ ROUTINE : Aufwiedersehen $ PURPOSE : Inform the user that the program is ending $ INPUT : (none) $ OUTPUT : (none) T FILE DIVIDE Utility ',k_PgmVersion); WRITELN('Not (C) Copyright ',k_PgmDate,' by ',k_PgmAuthor); WRITELN; WRITELN('This program divides large TEXT files into smaller files'); WRITELN('with the size of the smaller files under user Introduce the user to the program $ INPUT : (none) $ OUTPUT : (none) $ NOTES : (none) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ } PROCEDURE Introduction; BEGIN { ----- Introduction ----- } WRITELN('TEX [] [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } { $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ $ ROUTINE : Introduction $ PURPOSE : { ----- Int_To_String ----- } { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] [] [] M A J O R R O U T I N E S [] mbers } THEN BEGIN numString[position] := neg_Sign; position := position - 1; END; { Remove unused leading characters from numeric string } DELETE(numString,1,position); END; ition] := CHR(ORD('0') + (number MOD 10)); position := position - 1; number := number DIV 10; END; UNTIL number = 0; { Stop conversion when number converted } IF negative { Handle negative nu negative := (number < 0); { Init negative flag } number := ABS(number); { Convert only pos. numbers } REPEAT { Convert number one digit at a time to a numeric string } BEGIN numString[pos} BEGIN { ----- Int_To_String ----- } &numString := ''; &FOR position := 1 TO max_StrLength DO & numString := CONCAT(numString,' '); position := max_StrLength; { Init string digit index } e - thanks TK team }  $CONST &neg_Sign = '-'; { Negative sign } &max_StrLength = 11; { 10 digit characters + 1 sign character } %VAR 'negative : BOOLEAN; { Negative number flag } 'position : 1..max_StrLength; { Numeric string index nteger to convert | Output : numString - Numeric string -------------------------------------------------------------------- } PROCEDURE Int_To_String(number : INTEGER; VAR numString : t_String); { borrowed from the Apple Lisa ToolKit source cod ELSE string_To_Int := result; END; { ----- String_To_Int ----- } { -------------------------------------------------------------------- | Routine : Int_To_String | Purpose : Convert an INTEGER to a string | Input : number - I'0'); END; UNTIL (i = LENGTH(s)) OR NOT(conv_ok); END; IF negative THEN result := - result; END; END; IF NOT(conv_ok) THEN string_To_Int := -1 --- } { $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ $ ROUTINE : Fetch_UserFile $ PURPOSE : Fetch the input & output files from the user $ INPUT : (none) $ OUTPUT : inFile - Input file name $ outFile - Output file name $ userIsDone - User termination flag $ NOTES : If the user presses only in response to the $ input file prompt, then userIsDone is set to TRUE. $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ WRITELN('??? CATALOG FEATURE NOT IMPLEMENENTED FOR A/// ???'); END; { ----- Show_Disk_Catalog ----- } { -------------------------------------------------------------------- } BEGIN { ----- Get_Input_File ----- } REPEAT isplay all files flag (FALSE -> show TEXT only) | Output : (none) -------------------------------------------------------------------- } PROCEDURE Show_Disk_Catalog(show_all : BOOLEAN); BEGIN { ----- Show_Disk_Catalog ----- } : t_String; answer : STRING[1]; { -------------------------------------------------------------------- | Routine : Show_Disk_Catalog [///] | Purpose : Display the catalog for a disk | Input : show_all - De : Get_Input_File | Purpose : Fetch input file name from user | Input : (none) | Output : inFile - File name from user -------------------------------------------------------------------- } PROCEDURE Get_Input_File; VAR str IF (answer = '') THEN answer := 'N'; IF (answer <> 'Y') AND (answer <> 'y') THEN outFile := ''; END; { ----- HandleOutFileExistance ----- } { -------------------------------------------------------------------- | Routin VAR answer : STRING[1]; BEGIN { ----- HandleOutFileExistance ----- } WRITELN(' *** WARNING: File "',outFile,'" already exists.'); WRITE (' Overwrite it (Y/N) [N] ? '); READLN(answer); | Input : (none) | Output : If user does not want to overwrite existing file, then | output file name, outFile, is made empty. -------------------------------------------------------------------- } PROCEDURE HandleOutFileExistance;'); the_file_name := ''; END; { ----- FileNotFoundWarning ----- } { -------------------------------------------------------------------- | Routine : HandleOutFileExistance | Purpose : Handle the file existance case for the output file -------------------------------------------------------------------- } PROCEDURE FileNotFoundWarning(VAR the_file_name : t_FileName); BEGIN { ----- FileNotFoundWarning ----- } WRITELN(' *** WARNING: File "',the_file_name,'" not found-------------------------------- | Routine : FileNotFoundWarning | Purpose : Print a file not found warning message | Input : the_file_name - Name of file not found | Output : the_file_name - Empty file name := IORESULT; IF (error = k_NoError) THEN BEGIN CLOSE(f); FileExists := TRUE; END ELSE FileExists := FALSE; END; { ----- FileExists ----- } { ----------------------------------------------------------------------------------------- } FUNCTION FileExists(the_file_name : t_FileName) : BOOLEAN; VAR f : TEXT; error : t_Error; BEGIN { ----- FileExists ----- } RESET(f,the_file_name); error { -------------------------------------------------------------------- | Routine : FileExists | Purpose : Test if a TEXT file exists | Input : the_file_name - Name of file to test | Output : FileExists - TRUE --> file exists ---------------$$$$$$$$$$$$$$ } PROCEDURE Fetch_UserFile (VAR inFile : t_FileName; VAR outFile : t_FileName; VAR userIsDone : BOOLEAN); BEGIN WRITE('Enter TEXT file to divide [',k_TextSuffix,'] ? '); READLN(inFile); str := inFile; Trim_Leading (str,' '); Trim_Trailing(str,' '); inFile := str; userIsDone := (inFile = ''); IF userIsDone THEN BEGIN WRITE(' Are you sure you wish to QUIT (Y/N) [N] ? '); READLN(answer); IF (answer = '') THEN answer := 'N'; userI END; { ----- Get_Input_File ----- } { -------------------------------------------------------------------- | Routine : Get_Output_File | Purpose : Fetch output file name from the user | Input : (none) | Output : outFile - User output fil END; END; END; END; END; END; END; UNTIL (inFile <> '') OR userIsDone; inFile := CONCAT(inFile,k_TextSuffix); IF NOT(FileExists(inFile)) THEN FileNotFoundWarning(inFile); END; NLength:1,'chars)'); inFile := ''; END ELSE { Add suffix to end & test existance } BEGIN IF (LENGTH(inFile) > F k_MaxFNLength-LENGTH(k_TextSuffix)) GTHEN BEGIN WRITELN( H' *** WARNING: ', H'File name too long ', H'(> ',k_MaxF LENGTH(inFile)-LENGTH(k_TextSuffix)+1) THEN FileNotFoundWarning(inFile) ELSE { Suffix not at the end of the file name } BEGIN END; END ELSE { File name contains the standard suffix } BEGIN IF (POS(k_TextSuffix,inFile) = BEGIN inFile := CONCAT(inFile,k_TextSuffix); IF NOT(FileExists(inFile)) THEN FileNotFoundWarning(inFile); WRITELN( F' *** WARNING: ', F'File name too long ', F'(> ',k_MaxFNLength:1,' chars.'); inFile := ''; END ELSE BEGIN { File name does not contain the suffix } IF (LENGTH(inFile) > k_MaxFNLength-LENGTH(k_TextSuffix)) THEN BEGIN FileNotFoundWarning(inFile); END ELSE { File name does NOT end in a period } BEGIN IF (POS(k_TextSuffix,inFile) = 0) THEN nFile[LENGTH(inFile)] = '.') THEN BEGIN DELETE(inFile,LENGTH(inFile),1); IF (inFile <> '') THEN IF NOT(FileExists(inFile)) THEN inFile := ''; END ELSE BEGIN UpperCasePhrase(inFile); IF NOT(FileExists(inFile)) THEN BEGIN IF (isDone := (answer = 'Y') OR (answer = 'y'); END ELSE BEGIN IF (inFile = '?') OR (inFile = '??') THEN BEGIN Show_Disk_Catalog( (inFile = '??') ); e name -------------------------------------------------------------------- } PROCEDURE Get_Output_File; VAR default_file : t_FileName; str : t_String; BEGIN { ----- Get_Output_File ----- } REPEAT BEGIN default_file := inFile; IF (POS(k_TextSuffix,default_file) > 0) THEN DELETE(default_file, POS(k_TextSuffix,default_file), LENGTH(k_TextSuffix)); WRITE( UNTIL conv_ok; END; { ----- GetFileKSize ----- } { -------------------------------------------------------------------- } BEGIN { ----- Divide_UserFile ----- } GetFileKSize(int_fsize); WRITELN; WRITELN('Dividing file READLN(file_size); file_K_size := String_To_Int(file_size,conv_ok); IF NOT(conv_ok) THEN WRITELN('*** ERROR: ', 'Invalid number --- please try again'); END; E GetFileKSize(VAR file_K_size : t_BigINTEGER); VAR file_size : t_String; conv_ok : BOOLEAN; BEGIN { ----- GetFileKSize ----- } REPEAT BEGIN WRITE('Enter divided file size (in Kbytes) ? '); ----- | Routine : GetFileKSize | Purpose : Fetch the size of the output files, in KBytes, from user | Input : (none) | Output : file_K_size - Output file size -------------------------------------------------------------------- } PROCEDUR file_count : INTEGER; { File count (index) value } div_file : t_FileName; { Division file name } error : t_Error; { Processing error code result } { --------------------------------------------------------------- out_suffix : t_String; { Output file suffix } line : t_String; { A line of file data } byte_count : t_BigINTEGER; { Input file byte count } fc_string : t_String; { File count (index) string } R f_in : TEXT; { Input file reference } f_out : TEXT; { Output file reference } int_fsize : t_BigINTEGER; { Input file size in bytes } limit_found : BOOLEAN; { File byte limit exceeded flag }$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ } PROCEDURE Divide_UserFile (inFile : t_FileName; outFile : t_FileName); TYPE t_BigINTEGER = INTEGER[8]; { Large INTEGER (> 32767) [///] } VA $ INPUT : inFile - Name of file to divide $ OUTPUT : outFile - Output file names $ NOTES : Each output file name consists of the name of the $ output file as supplied by the user, and a 2 digit $ sequential number. $$${ And get the output file name } Get_Output_File; END; { ----- Fetch_UserFile ----- } { $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ $ ROUTINE : Divide_UserFile $ PURPOSE : Divide input file into other files ----------------------------------- } BEGIN { ----- Fetch_UserFile ----- } WRITELN; { Make certain prompt is at line start } Get_Input_File; { Get the input file name } IF NOT(userIsDone) THEN perCasePhrase(outFile); IF FileExists(outFile) THEN HandleOutFileExistance; END; END; UNTIL (outFile <> ''); END; { ----- Get_Output_File ----- } { --------------------------------- IF (outFile = '') THEN BEGIN outFile := default_file; IF FileExists(outFile) THEN HandleOutFileExistance; END ELSE BEGIN Up'Enter output file ', '[',default_file,k_OutFSuffix,'] ? '); READLN(outFile); str := outFile; Trim_Leading (str,' '); Trim_Trailing(str,' '); outFile := str; "',inFile,'" into "',outFile,'" ...'); WRITELN; RESET(f_in,inFile); error := IORESULT; IF (error <> k_NoError) THEN ShowError(error,CONCAT('Opening file "',inFile,'" failed')) ELSE BEGIN out_suffix := k_OutFSuffix; IF (POS(k_OutFSuffix,outFile) > 0) THEN DELETE(outFile, POS(k_OutFSuffix,outFile), LENGTH(k_OutFSuffix)); IF (POS(k_TextSuffix,outFile) > 0) THEN DELETE(outFileġ,۾;áڲ۾ ˍ۲Í.Fؾؾ$Í?ؾؾ_Íؾ:Íؾ$ÍٓزÍزɡؾؾ.ÍٓزÍزɡؾ.á? F I N I S [] [] [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } { Say farewell to the user } Aufwiedersehen; $ END. { ----- File_Divide ----- } { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] [] [] files to divide } REPEAT BEGIN Fetch_UserFile (g_InputFile,g_OutputFile,g_UserIsDone); IF NOT(g_UserIsDone) THEN Divide_UserFile (g_InputFile,g_OutputFile); END; UNTIL g_UserIsDone; [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } BEGIN { ----- File_Divide ----- } " { Introduce the user to the program } Introduction; { Prompt user for ----- Divide_UserFile ----- } { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] [] [] T H E M A I N E V E N T [] [] END; END; UNTIL (error <> k_NoError) OR EOF(f_in); IF (error <> k_NoError) THEN ShowError(error,CONCAT('Writing to file "',div_file,'" failed')); CLOSE(f_in); END; END; { RITELN(f_out,line); error := IORESULT; END; END; UNTIL (error <> k_NoError) OR limit_found OR EOF(f_in); WRITELN('[',byte_count:8,']'); CLOSE(f_out,LOCK); IF (error = k_NoError) THEN BEGIN byte_count := byte_count + LENGTH(line) + 1; limit_found := (byte_count >= int_fsize * 1024); WREWRITE(f_out,div_file); error := IORESULT; IF (error = k_NoError) THEN BEGIN byte_count := 0; REPEAT BEGIN READLN(f_in,line); error := IORESULT; IF (file_count < 10) THEN fc_string := CONCAT('0',fc_string); div_file := CONCAT(outFile,'.',fc_string,out_suffix); WRITE(' Writing to file "',div_file,'" ... '); , POS(k_TextSuffix,outFile), LENGTH(k_TextSuffix)); file_count := -1; REPEAT BEGIN file_count := file_count + 1; Int_To_String(file_count,fc_string); ؾزȡ<ؾ0̀ƀƀצ?ƀؾؾزÍ̀̀ʀʀȡʀʀʀ̀?ؾزȡ<ؾ0̀ƀƀ?ƀؾؾزÍ̀̀ʀʀȡʀʀʀ̀Ùʀ̀ʀ̀̀ʀ8ʀʀtʀtʀ Y  Ij ~ WAP /// SIG PUBLIC DOMAIN LIBRARY PDS NAME: David Craig Disk #1 DISK ID#: 3PCL-13 SUBJECT: Pascal BOOTABLE?: Bootable DESCRIPTION: Disks 3PCL-13, 14 and 15 are some of the nuggets we got from a donation by Joe Dobrowolski (of Apple Users ng failed [ʁ ]ƅVƁƃ/Ɓ 4*ꓡ</NH  f 4Hl$"$@"$%b%%%b&&&&'R''B!צ( sorting assembly file back-patches ...ʆWƁʁˡD# writing formatted output file ...ʆWƆXƁʁˡʆXšg-*** NOTE: Pretty formatting failed at line # ʆX צ [ʁ ]Fצ$*** NOTE: Pretty formatti file "":̆XƅVƁʁˡLצ(*** NOTE: Initializing BP cache failed [ʁ ]צ- scanning assembly file for back-patches ...ƆWƁʁˡצ( sorting assembly file bac1.00/) /צThat's all, Folks ...//ˡ //$&(ZZƀ٪تƃ/ƅUƁƃ.צFormatting assembly file "ƀ"צ to/ƀ/Wƀġ<ƀ|á$šá/ƀ/ ƀ*á /ƀ/á؞" ˍá) writing opcode frequency statistics ...áZ//(/צVʀƀ ˡáƀƀƀá/PAGE -ƀצPAGE -ƀɄצCurrent memory available:ƀצCurrent memory available:ƀɄצblocks for procedure codeƀצblocks for procedure codeƀ//"áKá/š//" ˍ,Ų*˄//"  ؞"ˡ/؞"ˡš̀pace isɄtצPAGE -צPAGE -Ʉ"//"'ġ!//" ؍ˍá /"Assembly complete:ײŦAssembly complete:ײɄu///SYMBOL TABLE DUMP////"צ PB - PublicŦ PB - PublicײɄ//"áášצCurrent minimum space isצCurrent minimum sƀʀƀʀáG̀ƀƀצ|ƀ //צ " תöˍ//"2 !צ AB - AbsoluteŦ AB - AbsoluteײɄS/ V   2á* [ ]  á."v|á̀ƀƀצ|ƀá/|ײ̀ʀšáÄÄÄ #ˡ]ÍR****ײ á 3 B *á8**ײ á  ℡+šؓ0ɡ F9ٕ~0ɡ F9ٕ~0ɡ F9ٕIJ~ *Ä  ~ á   Group International). We call them "David Craig Disks 1,2 and 3" since the material on these disks were all placed into the PD by (yes, that's right....) ///er David Craig. All require knowledge of Pascal to operate properly. On Side One: -: MUSIC: M