LnSOS BOOT 1.1 SOS.KERNEL SOS KRNLI/O ERRORFILE 'SOS.KERNEL' NOT FOUND%INVALID KERNEL FILE: xةw,@  ȱlmi8#)!)N^g?TESTUNIT.TEXT'LܢܢTESTUNIT2.TEXT0ܢܢLIBRARY.CODE ܢGENUTIL.CODE!@.SYSTEM.LIBRARY1`ܢܢ,LIBRARY.CODE ܢ `SYSTEM.LIBRARY0^ܢܢTESTBTREE.TEXT ܢܢVIDEOTAPE.INV<ܢPUTLIBu' ,GENUTIL.TEXT -GENUTIL2.TEXT#Dܢܢ-GENUTIL3.TEXT4(/FILEACCESS.TEXTI8ܢܢ*BTREE.TEXTd +BTREE2.TEXTk >dLԡm#i㰼m#iЕOLԡȱfg hi !dLԡ憦  Ljmkm l y`2 Lԡ8(Je稽)ʈ@L TRING; 8RSPKIND: ATTRIBSET); &PROCEDURE FMTNUM(RAWSTRG: STRING; VAR FMTSTRG: STRING; 9HOWJUST: DIRECTION; 9MAXLEN: INTEGER; FMTSPECS: ATTRIBSET); &PROCEDURE SCREENMSG(XPOS, YPOS: INTEGER; COMMAND: SCRCOMMAND; =MESSAGE: STRING); &PROCEDURE RESPOND(MSEND, DIVISOR: LONG; VAR LQUOTIENT, LREMDR: LONG); &PROCEDURE LOCATE(BLOCKED: BOOLEAN; 9ENTNUM, ENTLEN, PAGELEN, RESRVD, DISPLACE: INTEGER; 9VAR PAGENUM, POSNUM: INTEGER); &PROCEDURE PROMPT(RSPX, RSPY, RSPLEN: INTEGER; DEFAULT: STRING; 8VAR RESPONSE: S# FUNCTION FIRSTNON(HOWJUST: DIRECTION; PADCHR: CHAR; SRCSTRG: STRING) /: INTEGER; &PROCEDURE EVALUATE(STRG: STRING; VAR VALUE: LONG; VAR CURPOS: INTEGER); # FUNCTION EVALINT(STRG: STRING; VAR CURPOS: INTEGER) /: INTEGER; &PROCEDURE LONGDIV(DIVIDEAN; 9VALIDCHR: CHARSET); &PROCEDURE CHGLEN(VAR STRG: STRING; NEWLEN: INTEGER); &PROCEDURE MAKESTRG(CH: CHAR; VAR STRG: STRING); &PROCEDURE JUSTIFY(SRCSTRG: STRING; VAR DSTSTRG: STRING; :HOWJUST: DIRECTION; PADCHR: CHAR; :NEWLEN: INTEGER); +: PACKED ARRAY[0..255] OF CTRLTYPE; )DATEDELIM +: STRING[1]; )TODAY +: STRING[6]; )REPORTCTRL +: RPTCTRL; )OUTTEXT +: TEXT; & &PROCEDURE DELAY(DURATION: INTEGER); &PROCEDURE SOUNDBELL; # PROCEDURE GETCHR(NUMDELAYS: INTEGER; WITHBELLS: BOOLNER: STRING; 0END; (* RECORD *) & &VAR )BACKGROUND, )ESC, )NULL, )RSPCHR, )RET, )UNDERSCORE +: CHAR; )ESCTYPED +: BOOLEAN; )ERRNUM, )MINDIGITS, )NUMPLACES +: INTEGER; )ALTCHR, )CTRLCHR, )DIGITS, )NORMALCHR, )NULLSET +: CHARSET; )CTRL+= (QUIET, ERROR, WARNING, ATTENTION); + )OUTDEVICE += (PRINTER, SCREEN); * )LINETYPE += (PRINT, SKIP); & )RPTCTRL += RECORD 0PRINTAREA: INTEGER; 0PHYSICAL: INTEGER; 0LINESONPAGE: INTEGER; 0PAGENUMBER: INTEGER; 0OUTPUTTO: OUTDEVICE; 0RPTBANRIC, /PARENS, /SIGNED, /TRAILMINUS, /STDDATE, /ABBRMON, /FULLMON, /FULLYEAR, /DMY, /YMD); ) )ATTRIBSET += SET OF ATTRIBUTE; & )DATEINT += PACKED RECORD 0DAY: 0..31; 0MONTH: 0..13; 0YEAR: 0..99; 0END; (* RECORD *) & )MSGTYPE .CLRSCREEN); ) )CTRLTYPE += (NOTCTRL, .DUPCHR, .BACKSPACE, .INSCHR, .BEGFLD, .ENDFLD, .DELCHR, .CLRTOEND, .ACCEPT, .TRUNCATE, .RESTORE, .ESCAPE); & )ATTRIBUTE ,= (ALTONLY, /COMMAS, /DECIMAL, /DOLLAR, /FIXED, /NOECHO, /NOESC, /NUME ' '; )DASH += '-'; )SCRCOLS += 80; ) &TYPE )ACCESS += (RETRIEVE, .STORE); ) )DIRECTION += (CENTER, 0LEFT, 0DOWN, 0RIGHT, 0UP);  )LONG += INTEGER[12]; + # CHARSET += SET OF CHAR; ) )SCRCOMMAND += (NULLCMD, .CLRLINE,  (*$S+*)  (* Swapping option required for UNITs *)  (*$V-*)  UNIT GENUTIL; INTRINSIC CODE 20 DATA 21; #(* $* GENERAL UTILITY MODULES $* LAST UPDATED: 07-22-81 $* $*) # #INTERFACE # &USES )APPLESTUFF; ) &CONST )NULLSTRG += ''; )SPACE +=GKIND: MSGTYPE; MESSAGE: STRING); &PROCEDURE STRGDATE(DATE: DATEINT; VAR DATESTRG: STRING); &FUNCTION VALIDDATE(DATESTRG: STRING; VAR DATE: DATEINT) /: BOOLEAN; &PROCEDURE FMTDATE(DATESTRG: STRING; VAR FMTSTRG: STRING; :FMTSPECS: ATTRIBSET); &FUNCTION DATECOMPARE(LEFTDATE, RIGHTDATE: STRING) /: INTEGER; &PROCEDURE STDSCREEN(BANNER: STRING); &PROCEDURE INITREPORT(PRTAREA, PHYSLEN: INTEGER; BANNER: STRING; =OUTDEV: OUTDEVICE); &FUNCTION ROOMONPAGE(PRINTSKIP: LINETYPE; TESTLINES, ADDLINES: )BEGIN (* GETCHR *) , ,(* TURN ON CURSOR *) ,WRITE(CHR(5)); , ,REPEAT /WHILE (NUMDELAYS<> 0) AND (NOT KEYPRESS) DO 2BEGIN 5IF WITHBELLS THEN 8(* ISSUE BELLS WHILE WAITING *) 8SOUNDBELL; 5(* WAIT A BIT *) DELAY(300); 5(* DE) ** IF NUMDELAYS= 0, ** KEYTPED WILL RETURN THE LAST CHARACTER TYPED ** PRIOR TO THE CALL ** IF NUMDELAYS> 0, ** GETCHR WILL WAIT THE SPECIFIED NUMBER OF DELAYS ** OR EXIT WHEN A KEY IS TYPED. ** **) )VAR ,VALIDKEY .: BOOLEAN; (* ** DETECTS OR AWAITS TYPING OF A KEY, ** OPTIONALLY ISSUING BELLS WHILE WAITING. ** RSPCHR IS NULL OR THE CHARACTER TYPED. ** IF NUMDELAYS< 0, ** GETCHR WILL WAIT UNTIL USER TYPES A VALID CHARACTER ** (ANY CHARACTER, IF VALIDCHR= NULLSET 1 TO DURATION DO; )END; (* OF DELAY *) & &PROCEDURE SOUNDBELL; )(* ** SOUND A BELL ** **) )BEGIN (* SOUNDBELL *) ,WRITE(CHR(7)); )END; (* OF SOUNDBELL *) ) # PROCEDURE GETCHR(*NUMDELAYS: INTEGER; WITHBELLS: BOOLEAN; :VALIDCHR: CHARSET*); ) (* !* GENUTIL2.TEXT !* PART 2 OF GENERAL UTILITY MODULES !* LAST UPDATED: 07-23-81 !* !*) &PROCEDURE DELAY(*DURATION: INTEGER*); )(* ** WAIT A SMALL INTERVAL OF TIME ** **) & VAR ,TMPINT .: INTEGER; & BEGIN (* DELAY *) ,FOR TMPINT:= !"#$%&'()*+,-./012N^ƣINTEGER;  0); 2END; (* WHILE *) /VALIDKEY:= (VALIDCHR= NULLSET); /IF KEYPRESS THEN 2(* KEY WAS TYPED *) 2BEGIN 5(* GET THE CHARACTER WHICH WAS TYPED *) 5READ(KEYBOARD, RSPCHR); 5(* TURN ON CURSOR *) 5WRITE(CHR(5)); , / IF EOLN(KEYBOARD) THEN 8RSPCHR:= RET; 5IF NOT VALIDKEY THEN 8IF (RSPCHR IN VALIDCHR) THEN ;VALIDKEY:= TRUE 8ELSE ;SOUNDBELL; 2END /ELSE 2RSPCHR:= NULL; ,UNTIL VALIDKEY; ) ESCTYPED:= (RSPCHR= ESC); )END; (* OF EVALUATE *) & &FUNCTION EVALINT(*STRG: STRING; VAR CURPOS: INTEGER) /: INTEGER*); & (* ** EVALUATE THE NEXT INTEGER PART OF STRG AS EVALINT; ** RETURN THE POSITION OF THE FIRST NON-NUMERIC CHARACTER ** IN CURPOS. ** **) )VAR ,OT NEGATIVE; ADONE:= FALSE; 2 END; (* IF *) 5END; (* IF *) 2IF NOT DONE THEN 5BEGIN 8CURPOS:= CURPOS+ 1; 8DONE:= (CURPOS> LENGTH(STRG)); / END; (* IF *) /END; (* WHILE *) ,IF NEGATIVE THEN /VALUE:= -VALUE; ]; 2IF TMPCHR IN DIGITS THEN 5BEGIN 8VALUE:= 10* VALUE+ ORD(TMPCHR)- 48; 8NODIGITS:= FALSE; 5END 2ELSE 5(* CHARACTER IS NOT A DIGIT *) 5BEGIN 8DONE:= TRUE; 8IF TMPCHR= DASH THEN ;IF NODIGITS THEN >(* LEADING MINUS SIGN *) >BEGIN ANEGATIVE:= NCURPOS. ** **) )VAR ,DONE, ,NEGATIVE, ,NODIGITS /: BOOLEAN; ,TMPCHR /: CHAR; )BEGIN (* EVALUATE *) ) NEGATIVE:= FALSE; ,NODIGITS:= TRUE; ,VALUE:= 0; ,DONE:= (LENGTH(STRG)= 0); ,CURPOS:= 1; ,WHILE NOT DONE DO /BEGIN 2TMPCHR:= STRG[CURPOS)END; (* OF FIRSTNON *) & &PROCEDURE EVALUATE(*STRG: STRING; VAR VALUE: LONG; VAR CURPOS: INTEGER*); # (* ** EVALUATE THE LEADING NUMERIC CHARACTERS OF STRG. ** RETURN VALUE AND THE POSITION OF THE FIRST NON-NUMERIC ** CHARACTER IN STRG AS RCSTRG[CURPOS]= PADCHR THEN ;(* STRING STILL MATCHES PADCHR *) ;BEGIN >DONE:= (CURPOS= ENDPOS); >CURPOS:= CURPOS+ INCR; ;END 8ELSE ;(* FIRST NON-PADCHR FOUND *) ;DONE:= TRUE; 5END; (* WHILE *) ) END; (* IF *) ) FIRSTNON:= CURPOS; 1; 8ENDPOS:= LENGTH(SRCSTRG); 5END; (* CASE LEFT *) /RIGHT: BEGIN 9CURPOS:= LENGTH(SRCSTRG); 9INCR:= -1; 9ENDPOS:= 1; 6END; (* CASE RIGHT*) /END; (* CASE *) ,IF SRCSTRG<> NULLSTRG THEN , BEGIN 2DONE:= FALSE; 2WHILE NOT DONE DO 5BEGIN 8IF S)END; (* OF JUSTIFY *) & &FUNCTION FIRSTNON(*HOWJUST: DIRECTION; PADCHR: CHAR; SRCSTRG: STRING) /: INTEGER*); )VAR ,CURPOS, ,ENDPOS, ,INCR /: INTEGER; ,DONE /: BOOLEAN; )BEGIN (* FIRSTNON *) ,CASE HOWJUST OF /LEFT: BEGIN 8CURPOS:= 1; 8INCR:=5RIGHT: STPOS:= NEWLEN- LENGTH(TMPSTRG)+ 1; 5CENTER: STPOS:= (NEWLEN- LENGTH(TMPSTRG)) DIV 2+ 1; 5END; (* CASE *) 2(* MOVE THE SOURCE STRING INTO THE DESTINATION STRING *) 2MOVELEFT(TMPSTRG[1], DSTSTRG[STPOS], LENGTH(TMPSTRG)); ) END; (* IF *) ING WITH PADCHR *) ,IF LENGTH(TMPSTRG)<> NEWLEN THEN /FILLCHAR(DSTSTRG[1], NEWLEN, PADCHR); ,(* DETERMINE WHERE IN THE DESTINATION STRING TO BEGIN 1MOVING THE SOURCE STRING *) ,IF LENGTH(TMPSTRG)> 0 THEN /BEGIN 2CASE HOWJUST OF 5LEFT: STPOS:= 1; GIN (* JUSTIFY *) ) TMPSTRG:= SRCSTRG; ,(* IF SRCSTRG IS TOO LONG, SHORTEN IT *) ,IF LENGTH(TMPSTRG)> NEWLEN THEN /CHGLEN(TMPSTRG, NEWLEN); ,(* MAKE THE DESTINATION STRING THE PROPER LENGTH *) ,CHGLEN(DSTSTRG, NEWLEN); ,(* FILL THE DESTINATION STRTRG: STRING; VAR DSTSTRG: STRING; :HOWJUST: DIRECTION; PADCHR: CHAR; :NEWLEN: INTEGER*); # (* ** LEFT/RIGHT/CENTER JUSTIFY A STRING FOR THE SPECIFIED LENGTH ** USING PADCHR ** **) ) VAR /STPOS 2: INTEGER; ) TMPSTRG 2: STRING; )BE&PROCEDURE MAKESTRG(*CH: CHAR; VAR STRG: STRING*); & (* ** MAKE A CHARACTER INTO A STRING ** **) )BEGIN (* MAKESTRG *) ) (* MAKE THE LENGTH ONE CHARACTER *) ,CHGLEN(STRG, 1); ,STRG[1]:= CH; )END; (* OF MAKESTRG *) ) &PROCEDURE JUSTIFY(*SRCS)END; (* OF GETCHR *) & &PROCEDURE CHGLEN(*VAR STRG: STRING; NEWLEN: INTEGER*); & (* ** CHANGE THE LENGTH OF STRG TO NEWLEN. ** **) )BEGIN (* CHGLEN *) ) (*$R-*) ,STRG[0]:= CHR(NEWLEN); ,(*$R+*) )END; (* OF CHGLEN *) & TMPLONG /: LONG; )BEGIN (* EVALINT *) ) EVALUATE(STRG, TMPLONG, CURPOS); ,IF (TMPLONG> -32768) AND (TMPLONG< 32768) THEN /(* NUMBER IS AN INTEGER *) /EVALINT:= TRUNC(TMPLONG) ,ELSE /(* NOT AN INTEGER; RETURN ZERO *) /EVALINT:= 0; )END; (* OF EVALINT *) & #PROCEDURE LONGDIV(*DIVIDEND, DIVISOR: LONG; VAR LQUOTIENT, LREMDR: LONG; *); &(* '* PERFORMS DIV AND MOD FOR LONG INTEGER '* RETURNS QUOTIENT IN LQUOTIENT; '* RETURNS REMAINDER IN LREMDR. '* '*) &BEGIN (* LONGDIV *) )LQUOTIENT:=;SCREENMSG(RSPX, RSPY, NULLCMD, RESPONSE); ;WRITE(UNDERSCORE); 8END; (* CASE LEFT *) ; 1RIGHT: BEGIN ;INSERT('^', RESPONSE, RSPPOS+ 1); ;SCREENMSG(RSPX, RSPY, NULLCMD, RESPONSE); 8END; (* CASE RIGHT *) 3 3END; (* CASE *) , ,END; (* OF SHIFT *) )PROCEDURE SHIFT(SHIFTDIR: DIRECTION); ,BEGIN (* SHIFT *) /CASE SHIFTDIR OF 2 2LEFT: BEGIN ;IF RSPPOS< LENGTH(RESPONSE) THEN >DELETE(RESPONSE, GRSPPOS+ ORD((CTRLKIND<> NOTCTRL) OAND ((CTRLKIND<> BACKSPACE) OOR (RSPPOS= INSPOS))), 1); Y, RSPLEN: INTEGER; DEFAULT: STRING; 8VAR RESPONSE: STRING; 8RSPKIND: ATTRIBSET*); )VAR ,INSERTING, ,TERMINATED, ,TMPBOOL .: BOOLEAN; ,CTRLKIND .: CTRLTYPE; ,FMTLEN, ,INSPOS, ,RSPPOS .: INTEGER; ,VALIDCHR .: CHARSET; ,TMPDEF .: STRING; # ADDTOCTRL(OPENAPPLE+ ORD('A'), ACCEPT); /(* OPEN-APPLE-A *) ,ADDTOCTRL(ORD(RET), TRUNCATE); ,ADDTOCTRL(OPENAPPLE+ ORD('R'), RESTORE); /(* OPEN-APPLE-R *) ,ADDTOCTRL(ORD(ESC), ESCAPE); )END; (* OF INITCTRL *) & &(*$R-*) &PROCEDURE PROMPT(*RSPX, RSP,ADDTOCTRL(OPENAPPLE+ ORD('B'), BEGFLD); /(* OPEN-APPLE-B *) ,ADDTOCTRL(OPENAPPLE+ ORD('E'), ENDFLD); /(* OPEN-APPLE-E *) ,ADDTOCTRL(OPENAPPLE+ ORD('D'), DELCHR); /(* OPEN-APPLE-D *) ,ADDTOCTRL(OPENAPPLE+ ORD('C'), CLRTOEND); /(* OPEN-APPLE-C *) ,CHR:= NULLSET; ,FOR TMPCHR:= SPACE TO CHR(127) DO /NORMALCHR:= NORMALCHR+ [TMPCHR]; ,ADDTOCTRL(21, DUPCHR); /(* RIGHT-ARROW *) ,ADDTOCTRL(8, BACKSPACE); /(* LEFT-ARROW *) ,ADDTOCTRL(OPENAPPLE+ ORD('I'), INSCHR); /(* OPEN-APPLE-I *) TO TREAT ;OPEN-APPLE-(LOWER CASE) THE SAME AS ;OPEN-APPLE-(UPPER CASE) 3*) 2ADDTOCTRL(ASCIIVAL+ 32, CTRLKIND); ,END; (* OF ADDTOCTRL *) ) )BEGIN (* INITCTRL *) ,NULLSET:= []; ,DIGITS:= ['0'..'9']; ,CTRLCHR:= NULLSET; ,ALTCHR:= NULLSET; ,NORMALENAPPLE .= 128; )VAR ,TMPCHR .: CHAR; ) )PROCEDURE ADDTOCTRL(ASCIIVAL: INTEGER; CTRLKIND: CTRLTYPE); ,BEGIN (* ADDTOCTRL *) /CTRL[ASCIIVAL]:= CTRLKIND; /CTRLCHR:= CTRLCHR+ [CHR(ASCIIVAL)]; , /IF ASCIIVAL IN [193..218] THEN 2(* RECURSIVE CALL/LONGDIV(TMPLONG, PAGELEN- RESRVD, TMPLONG, TMPLREM); ,END; (* IF *) )PAGENUM:= TRUNC(TMPLONG); )POSNUM:= RESRVD+ TRUNC(TMPLREM)+ 1; &END; (* OF LOCATE *)  &PROCEDURE INITCTRL; )(* ** INITIALIZE THE PROMPT CONTROL CHARACTERS ** **) )CONST ,OPM- 1, TMPLONG, TMPLONG, TMPLREM); , TMPLREM:= TMPLREM* ENTLEN; ) END )ELSE ,BEGIN /(* COMPUTE TOTAL DISPLACEMENT TO THE ENTRY *) /TMPLONG:= ENTNUM; /TMPLONG:= (TMPLONG- 1)* ENTLEN+ DISPLACE; UM AT WHICH ENTRY IS TO BE FOUND '* '*) &VAR )TMPLONG, )TMPLREM ,: LONG; &BEGIN (* LOCATE *) )IF BLOCKED THEN ) BEGIN /TMPLONG:= (PAGELEN- RESRVD) DIV ENTLEN; /IF DISPLACE> 0 THEN 2ENTNUM:= ENTNUM+ (DISPLACE- 1) DIV ENTLEN+ 1; /LONGDIV(ENTNUGE '* DISPLACE: NUMBER OF ADDITIONAL UNITS BY WHICH ENTRIES ARE DISPLACED '* ON FIRST PAGE '* PAGELEN: LENGTH OF EACH PAGE, IN THE SAME UNITS AS ENTLEN '* PAGENUM: PAGE NUMBER ON WHICH ENTRY IS TO BE FOUND '* POSNUM: POSITION ON PAGEN'* LOCATE AN ENTRY IN A SEQUENCE OF '* PAGES; '* '* BLOCKED: TRUE IF ENTRIES DO NOT OVERLAP PAGE BOUNDARIES '* ENTNUM: NUMBER OF ENTRY TO BE LOCATED '* ENTLEN: LENGTH OF EACH ENTRY '* RESRVD: NUMBER OF RESERVED UNITS AT BEGINNING OF EACH PA DIVIDEND DIV DIVISOR; )LREMDR:= DIVIDEND- LQUOTIENT* DIVISOR; &END; (* OF LONGDIV *) # #PROCEDURE LOCATE(*BLOCKED: BOOLEAN; 6ENTNUM, ENTLEN, PAGELEN, RESRVD, DISPLACE: INTEGER; 6VAR PAGENUM, POSNUM: INTEGER*); &(* ) )FUNCTION CHARAT(CHRPOS: INTEGER) 2: CHAR; ,(* -* RETURNS THE CHARACTER AT POSITION CHRPOS IN RESPONSE -* -*) ,BEGIN (* CHARAT *) , IF CHRPOS> LENGTH(RESPONSE) THEN 2CHARAT:= UNDERSCORE /ELSE 2CHARAT:= RESPONSE[CHRPOS]; ,END; (* OF CHARAT *) , )PROCEDURE DOINSCHR; ,BEGIN (* DOINSCHR *) /CASE INSERTING OF 2 2FALSE: BEGIN TMPCHR:= TMPDEF[RSPPOS]; >RESPONSE[RSPPOS]:= TMPCHR; ;END 8ELSE ;BEGIN >TMPCHR:= UNDERSCORE; >DELETE(RESPONSE, RSPPOS, 1); ;END; (* IF *) 5RSPPOS:= RSPPOS- 1; 5GOTOXY(RSPX+ RSPPOS, RSPY); 5WRITE(TMPCHR); 1: CHAR; ,BEGIN (* DOBACKSPACE *) /IF RSPPOS= 0 THEN 2SOUNDBELL /ELSE 2BEGIN 5IF INSERTING THEN 8IF (RSPPOS= INSPOS) THEN ;BEGIN >DOINSCHR; >TMPCHR:= CHARAT(RSPPOS); ;END 8ELSE ;BEGIN >SHIFT(LEFT); >TMPCHR:= '^'; ;END 5ELSE 8IF RSPPOS<= WRITE(UNDERSCORE); 5END; (* IF *) / ,END; (* OF DONOTCTRL *) + )PROCEDURE DODUPCHR; ,BEGIN (* DODUPCHR *) /IF RSPPOS< LENGTH(RESPONSE) THEN 2RSPPOS:= RSPPOS+ 1 /ELSE 2SOUNDBELL; ,END; (* OF DODUPCHR *) ) )PROCEDURE DOBACKSPACE; ,VAR /TMPCHR /IF RSPPOS> LENGTH(RESPONSE) THEN 2CHGLEN(RESPONSE, RSPPOS); /RESPONSE[RSPPOS]:= RSPCHR; / /IF (SIGNED IN RSPKIND) THEN 2IF (RSPCHR<> DASH) AND (LENGTH(RESPONSE)= RSPLEN) THEN 5BEGIN 8CHGLEN(RESPONSE, RSPLEN- 1); 8GOTOXY(RSPX+ RSPLEN- 1, RSPY); 8/IF INSERTING THEN 2IF LENGTH(RESPONSE)= RSPLEN THEN 5DOINSCHR 2ELSE 5IF RSPLEN> (RSPPOS+ 1) THEN 8SHIFT(RIGHT); / /GOTOXY(RSPX+ RSPPOS, RSPY); /IF RSPCHR IN NORMALCHR THEN 2WRITE(RSPCHR); / /RSPPOS:= RSPPOS+ 1; GNED IN RSPKIND THEN 8IF (RSPCHR IN DIGITS) THEN ;(* TOO MANY DIGITS *) ;ERROR:= (CHARAT(1)<> DASH) AND F(RSPPOS= (RSPLEN- 1)) 8ELSE ;(* MINUS SIGN *) ;ERROR:= RSPPOS> 0; ; /IF ERROR THEN 2BEGIN 5SOUNDBELL; 5EXIT(DONOTCTRL); 2END; (* IF *) / ); / /ERROR:= FALSE; / /IF (RSPCHR IN ALTCHR) AND (NOT (ALTONLY IN RSPKIND)) THEN 2IF RSPPOS= 0 THEN 5TERMINATED:= TRUE 2ELSE 5ERROR:= TRUE /ELSE 2IF RSPPOS= RSPLEN THEN 5BEGIN 8IF INSERTING THEN ;DOINSCHR; 8ERROR:= TRUE; 5END 2ELSE 5IF SIBRESPONSE[RSPPOS+ 1]:= RSPCHR ?ELSE BSHIFT(LEFT);  (RSPPOS+ 1) THEN ESHIFT(RIGHT) BELSE EWRITE('^'); BINSPOS:= RSPPOS; BINSERTING:= TRUE; ?END  RSPPOS THEN ?IF (CTRLKIND= NOTCTRL) THEN GIN /RESPONSE:= DEFAULT; /RSPPOS:= LENGTH(DEFAULT); /SETDEFAULT; /RSPPOS:= 0; ,END; (* OF INITDEFAULT *) ) )PROCEDURE DORESTORE; ,BEGIN (* DORESTORE *) /IF RESPONSE= DEFAULT THEN 2SOUNDBELL /ELSE 2INITDEFAULT; ,END; (* OF DORESTORE *) + )PROCEDURE DOESCAPE; ,BEGIN (* DOESCAPE *) /RSPPOS:= 0; /TERMINATED:= TRUE; ,END; (* OF DOESCAPE *) , )PROCEDURE DISPRSP(SRCSTRG: STRING; CLRAREA: BOOLEAN); + BEGIN (* DISPRSP *) /IF STDDATE IN RSPKIND THEN 2FMTDATE(SRCSTRG, TMPDEF, RSPKIND) /ELSE 2 FALSE; ,EVALUATE(RAWSTRG, LONGVAL, TMPINT); ,IF LONGVAL< 0 THEN /BEGIN 2LONGVAL:= -LONGVAL; 2NEGATIVE:= TRUE; /END; (* IF *) ,IF LONGVAL> 0 THEN /(* 'NORMALIZE' THE NUMBER *) /STR(LONGVAL, FMTSTRG) ,ELSE /FMTSTRG:= NULLSTRG; ,TMPINT:= MINDIGIT ) &PROCEDURE FMTNUM(*RAWSTRG: STRING; VAR FMTSTRG: STRING; 9HOWJUST: DIRECTION; MAXLEN: INTEGER; 9FMTSPECS: ATTRIBSET*); )VAR ,NEGATIVE .: BOOLEAN; ,TMPINT .: INTEGER; ,LONGVAL .: LONG; ,TMPSTRG .: STRING[1]; )BEGIN (* FMTNUM *) ,NEGATIVE:= #(* $* GENUTIL3.TEXT $* LAST PART OF GENERAL UTILITIES MODULES $* LAST UPDATED: 07-29-81 $* # *) # &PROCEDURE INITFMT; )BEGIN (* INITFMT *) ,MINDIGITS:= 0; ,NUMPLACES:= 0; ,BACKGROUND:= SPACE; ) DATEDELIM:= DASH; )END; (* OF INITFMT *)356789:;<=>?@ABCDEFGN^SCHR) =AND (CTRLKIND<> BACKSPACE) THEN ;DOINSCHR; 5CASE CTRLKIND OF ;DUPCHR: DODUPCHR; 8BACKSPACE: DOBACKSPACE; ;INSCHR: DOINSCHR; ;BEGFLD: DOBEGFLD; ;ENDFLD: DOENDFLD; ;DELCHR: DODELCHR; 9CLRTOEND: DOCLRTOEND; ;ACCEPT: DOACCEPT; DCHR:= VALIDCHR- [ESC]; ,INITDEFAULT; /(* SET AND DISPLAY ORIGINAL DEFAULT *) ,REPEAT /GOTOXY(RSPX+ RSPPOS, RSPY); /GETCHR(0, FALSE, VALIDCHR); /IF RSPCHR IN CTRLCHR THEN 2BEGIN 5CTRLKIND:= CTRL[ORD(RSPCHR)]; 5IF INSERTING THEN 8IF (CTRLKIND<> INSPKIND) THEN 2BEGIN 4VALIDCHR:= DIGITS; 4IF SIGNED IN RSPKIND THEN 7BEGIN :RSPLEN:= RSPLEN+ 1; :VALIDCHR:= VALIDCHR+ [DASH] 7END; (* IF *) 2END /ELSE 2VALIDCHR:= NORMALCHR; ,VALIDCHR:= VALIDCHR+ ALTCHR+ CTRLCHR; ,IF NOESC IN RSPKIND THEN /VALI,END; (* OF DISPRSP *) ) )BEGIN (* PROMPT *) ,INSERTING:= FALSE; ,TERMINATED:= FALSE; ,RSPCHR:= NULL; ,FMTLEN:= RSPLEN; ,DISPRSP(NULLSTRG, TRUE); ,IF ALTONLY IN RSPKIND THEN , VALIDCHR:= NULLSET ,ELSE /IF (NUMERIC IN RSPKIND) OR (STDDATE IN RIF NUMERIC IN RSPKIND THEN 5FMTNUM(SRCSTRG, TMPDEF, LEFT, FMTLEN, RSPKIND) 2ELSE 5JUSTIFY(SRCSTRG, TMPDEF, LEFT, BACKGROUND, FMTLEN); /IF CLRAREA THEN 2JUSTIFY(NULLSTRG, TMPDEF, LEFT, SPACE, LENGTH(TMPDEF)); /SCREENMSG(RSPX, RSPY, NULLCMD, TMPDEF); S+ NUMPLACES; ,(* ADD LEADING ZEROES IF NEEDED *) ,IF LENGTH(FMTSTRG)< TMPINT THEN /JUSTIFY(FMTSTRG, FMTSTRG, RIGHT, '0', TMPINT); ,(* INSERT COMMAS IF SPECIFIED *) ,IF COMMAS IN FMTSPECS THEN /BEGIN 2TMPINT:= LENGTH(FMTSTRG)- NUMPLACES- 2; 2WHILE TMPINT> 1 DO 5BEGIN 8INSERT(',', FMTSTRG, TMPINT); 8TMPINT:= TMPINT- 3; 5END; (* WHILE *) /END; (* IF *) ,(* INSERT DECIMAL POINT IF SPECIFIED *) ,IF DECIMAL IN FMTSPECS THEN /INSERT('.', FMTSTRG, LENGTH(FMTSTRG)- NUMPLACES+ 1); ,IF TRAILMTHEN 5MONSTRG:= COPY(MONSTRG, 1, 3); /END; (* IF *) ,DAYSTRG:= COPY(DATESTRG, 3, 2); ,IF FULLMON IN FMTSPECS THEN /BEGIN 2TMPINT:= EVALINT(DAYSTRG, TMPINT); 2STR(TMPINT, DAYSTRG); /END; (* IF *) ,YEARSTRG:= COPY(DATESTRG, 5, 2); ,IF FULLYEAR IN F; 86: MONSTRG:= 'June'; 87: MONSTRG:= 'July'; 88: MONSTRG:= 'August'; 89: MONSTRG:= 'September'; 810: MONSTRG:= 'October'; 811: MONSTRG:= 'November'; 812: MONSTRG:= 'December'; 8END (* CASE *) 2ELSE 5MONSTRG:= 'UNKNOWN'; 2IF ABBRMON IN FMTSPECS 2OR (FULLMON IN FMTSPECS) THEN /BEGIN 2TMPINT:= EVALINT(MONSTRG, TMPINT); 2IF (TMPINT>= 1) AND (TMPINT<= 12) THEN 5CASE TMPINT OF 81: MONSTRG:= 'January'; 82: MONSTRG:= 'February'; 83: MONSTRG:= 'March'; 84: MONSTRG:= 'April'; 85: MONSTRG:= 'May'VAR ,TMPINT .: INTEGER; ,DAYSTRG, ,TMPSTRG .: STRING[2]; ,YEARSTRG .: STRING[4]; ,MONSTRG .: STRING[9]; )BEGIN (* FMTDATE *) ,JUSTIFY(DATESTRG, DATESTRG, LEFT, '0', 6); ,MONSTRG:= COPY(DATESTRG, 1, 2); ,IF (ABBRMON IN FMTSPECS) O /IF FNVALUE THEN 2BEGIN 5DAY:= DD; 5MONTH:= MM; 5YEAR:= YY; 2END /ELSE 2BEGIN 5DAY:= 0; 5MONTH:= 0; 5YEAR:= 0; 2END; (* IF *) )END; (* OF VALIDDATE *) 2 &PROCEDURE FMTDATE(*DATESTRG: STRING; VAR FMTSTRG: STRING; ;FMTSPECS: ATTRIBSET*); )ATESTRG, 5, 2), TMPPOS); ,IF (MM>= 1) AND (MM<= 12) THEN /MAXDAYS:= 31 ;- ORD(MM IN [4, 6, 9, 11]) ;- ORD(MM= 2)* ?(3- ORD((YY MOD 4)= 0)* ORD(YY<> 0)) ,ELSE /MAXDAYS:= -1; ,FNVALUE:= (DD> 0) AND (DD<= MAXDAYS); ,VALIDDATE:= FNVALUE; ,WITH DATE D,FNVALUE .: BOOLEAN; ,DD, ,MM, ,YY, ,MAXDAYS, ,TMPPOS .: INTEGER; )BEGIN (* VALIDDATE *) ,JUSTIFY(DATESTRG, DATESTRG, LEFT, '0', 6); ,MM:= EVALINT(COPY(DATESTRG, 1, 2), TMPPOS); ,DD:= EVALINT(COPY(DATESTRG, 3, 2), TMPPOS); ,YY:= EVALINT(COPY(DNTEGER PROBLEMS *) 2TMPLONG:= MONTH; 2STR(1000000+ TMPLONG* 10000+ DAY* 100+ YEAR, DATESTRG); /END; ,DATESTRG:= COPY(DATESTRG, 2, 6); )END; (* OF STRGDATE *) " &FUNCTION VALIDDATE(*DATESTRG: STRING; VAR DATE: DATEINT) /: BOOLEAN*); )VAR HR(31)); /CLRSCREEN: WRITE(CHR(29)); /END; (* CASE *) ) WRITE(MESSAGE); )END; (* OF SCREENMSG *) , &PROCEDURE STRGDATE(*DATE: DATEINT; VAR DATESTRG: STRING*); )VAR ,TMPLONG .: LONG; )BEGIN (* STRGDATE *) ,WITH DATE DO /BEGIN 2(* AVOID LONG IHEN /JUSTIFY(FMTSTRG, FMTSTRG, HOWJUST, BACKGROUND, MAXLEN); )END; (* OF FMTNUM *) ) &PROCEDURE SCREENMSG(*XPOS, YPOS: INTEGER; COMMAND: SCRCOMMAND; >MESSAGE: STRING*); )BEGIN (* SCREENMSG *) ,GOTOXY(XPOS, YPOS); ,CASE COMMAND OF /CLRLINE: WRITE(C/IF (SIGNED IN FMTSPECS) AND (NOT (TRAILMINUS IN FMTSPECS)) THEN 2BEGIN 5MAXLEN:= MAXLEN+ 1; 5IF NEGATIVE THEN 8TMPSTRG:= DASH 5ELSE 8MAKESTRG(BACKGROUND, TMPSTRG); 5FMTSTRG:= CONCAT(TMPSTRG, FMTSTRG); 2END; (* IF *) ,IF NOT (FIXED IN FMTSPECS) T FMTSPECS THEN /BEGIN 2MAXLEN:= MAXLEN+ 2; 2IF NEGATIVE THEN 5FMTSTRG:= CONCAT('(', FMTSTRG, ')') 2ELSE 5BEGIN 8MAKESTRG(BACKGROUND, TMPSTRG); 8FMTSTRG:= CONCAT(TMPSTRG, FMTSTRG, TMPSTRG); 5END /END ,ELSE IN FMTSPECS) 8+ ORD(TRAILMINUS IN FMTSPECS); ,IF FIXED IN FMTSPECS THEN /JUSTIFY(FMTSTRG, FMTSTRG, HOWJUST, BACKGROUND, MAXLEN); ,IF DOLLAR IN FMTSPECS THEN /BEGIN 2FMTSTRG:= CONCAT('$', FMTSTRG); 2MAXLEN:= MAXLEN+ 1; /END; (* IF *) ,IF PARENS ININUS IN FMTSPECS THEN /BEGIN 2IF NEGATIVE THEN 5TMPSTRG:= DASH 2ELSE 5MAKESTRG(BACKGROUND, TMPSTRG); 2FMTSTRG:= CONCAT(FMTSTRG, TMPSTRG); /END; (* IF *) ,MAXLEN:= MAXLEN 8+ ((MAXLEN- NUMPLACES- 1) DIV 3) >* ORD(COMMAS IN FMTSPECS) 8+ ORD(DECIMALMTSPECS THEN /YEARSTRG:= CONCAT('19', YEARSTRG); ,IF YMD IN FMTSPECS THEN /FMTSTRG:= CONCAT(YEARSTRG, DATEDELIM, BMONSTRG, DATEDELIM, BDAYSTRG) ,ELSE /BEGIN 2IF DMY IN FMTSPECS THEN 5FMTSTRG:= CONCAT(DAYSTRG, DATEDELIM, HMONSTRG) 2ELSE 5FMTSTRG:= CONCAT(MONSTRG, DATEDELIM, HDAYSTRG); 2IF FULLYEAR IN FMTSPECS THEN 5FMTSTRG:= CONCAT(FMTSTRG, ','); 2FMTSTRG:= CONCAT(FMTSTRG, DATEDELIM, EYEARSTRG); /END; (* IF *) )END; (* OF FMTDATE *) < &FUNCTION DATECOMPARE(*LEFTDATE, RIGHTDATE: TSKIP= PRINT THEN 8LINESONPAGE:= ADDLINES; 5PAGENUMBER:= PAGENUMBER+ 1; 6 2END; (* IF *) /IF ENDOFREPORT THEN 2ENDREPORT; ,END; (* WITH *) &END; (* OF ROOMONPAGE *) # # #BEGIN (* GENUTIL INITIALIZATION *) &ESC:= CHR(27); &NULL:= CHR(0); &RET:(RPTBANNER) CELSE FBEGIN IRESPOND(QUIET, CONTMSG); IIF ESCTYPED THEN LENDREPORT; FEND; (* IF *) @END; (* CASE SCREEN *) 8 8PRINTER: FOR TMPINT:= LINESONPAGE+ 1 TO PHYSICAL DO DWRITELN(OUTTEXT); < = (LINESONPAGE+ TESTLINES) THEN 2BEGIN 5ROOMONPAGE:= TRUE; 5IF OUTPUTTO= SCREEN THEN inue '; &VAR )TMPINT +: INTEGER; & &PROCEDURE ENDREPORT; )BEGIN (* ENDREPORT *) ,(*$I-*) ,CLOSE(OUTTEXT); ,(*$I+*) ,ERRNUM:= IORESULT; ,ROOMONPAGE:= FALSE; ,EXIT(ROOMONPAGE); )END; (* OF ENDREPORT *) & &BEGIN (* ROOMONPAGE *) )GETCHR(0, FAL END; (* IF *) 5END; (* IF *) /UNTIL ERRNUM= 0; ,END; (* WITH *) &END; (* OF INITREPORT *) # #FUNCTION ROOMONPAGE(*PRINTSKIP: LINETYPE; TESTLINES, ADDLINES: INTEGER; 9ENDOFREPORT: BOOLEAN) ,: BOOLEAN*); &CONST )CONTMSG += 'Type [RETURN] to cont5BEGIN 8(*$I-*) 8UNITCLEAR(6); 8(*$I+*) 8ERRNUM:= IORESULT; 5END; (* IF *) 2IF ERRNUM> 0 THEN 5BEGIN 8CLOSE(OUTTEXT); 8RESPOND(ERROR, CONCAT('UNABLE TO INITIALIZE ', AOUTNAME)); 8IF ESCTYPED THEN ;BEGIN >ERRNUM:= 0; >EXIT(INITREPORT); 5 R THEN 5BEGIN 8RESPOND(ATTENTION, :'Type [RETURN] when the printer is ready'); 8IF ESCTYPED THEN ;EXIT(INITREPORT); 2 END; (* IF *) 2(*$I-*) 2REWRITE(OUTTEXT, OUTNAME); 2(*$I+*) 2ERRNUM:= IORESULT; 2IF (OUTDEV= PRINTER) AND (ERRNUM= 0) THEN REA; /PHYSICAL:= PHYSLEN; /LINESONPAGE:= PHYSICAL; /PAGENUMBER:= 0; /OUTPUTTO:= OUTDEV; /RPTBANNER:= BANNER; /CASE OUTDEV OF 2PRINTER: OUTNAME:= 'PRINTER:'; 3SCREEN: OUTNAME:= 'CONSOLE:'; 6END; (* CASE *) /REPEAT 2ERRNUM:= 0; 2IF OUTDEV= PRINTE)SCREENMSG(0, 23, CLRLINE, NULLSTRG); &END; (* OF RESPOND *) # #PROCEDURE INITREPORT(*PRTAREA, PHYSLEN: INTEGER; BANNER: STRING; :OUTDEV: OUTDEVICE*); &VAR )OUTNAME +: STRING; &BEGIN (* INITREPORT *) )WITH REPORTCTRL DO ,BEGIN /PRINTAREA:= PRTA&VAR )NUMBELLS +: INTEGER; &BEGIN (* RESPOND *) )CASE MSGKIND OF 0QUIET: NUMBELLS:= 0; .WARNING, 0ERROR: NUMBELLS:= 1; ,ATTENTION: NUMBELLS:= 2; 2END; (* CASE *) )SCREENMSG(0, 23, CLRLINE, MESSAGE); )GETCHR(NUMBELLS, TRUE, [ESC, RET]+ ALTCHR); DAY<> NULLSTRG THEN /BEGIN 2FMTDATE(TODAY, TMPSTRG, [DMY, ABBRMON]); 2SCREENMSG(SCRCOLS- LENGTH(TMPSTRG), 0, NULLCMD, TMPSTRG); , END; (* IF *) ,GOTOXY(0, 23); )END; (* OF STDSCREEN *) & #PROCEDURE RESPOND(*MSGKIND: MSGTYPE; MESSAGE: STRING*); R: STRING*); )VAR ,TMPSTRG .: STRING[SCRCOLS]; )BEGIN (* STDSCREEN *) ,JUSTIFY(BANNER, TMPSTRG, LEFT, '.', SCRCOLS); ,SCREENMSG(0, 0, CLRSCREEN, TMPSTRG); ,JUSTIFY(NULLSTRG, TMPSTRG, LEFT, '"', SCRCOLS); ,SCREENMSG(0, 21, NULLCMD, TMPSTRG); ,IF TOSTRING) /: INTEGER*); )BEGIN (* DATECOMPARE *) ,FMTDATE(LEFTDATE, LEFTDATE, [YMD]); ,FMTDATE(RIGHTDATE, RIGHTDATE, [YMD]); ,DATECOMPARE:= ORD(LEFTDATE> RIGHTDATE)-  0 THEN 5EXIT(PUTHDR); 2HDRPUT:= FALSE; /END; (* IF *) )END; (* OF PUTHDR *)  &PROCEDURE GETHDR(VAR FVAR: FILEVAR; ,WITH PFPARS^, FHDR.PARS^ DO /BEGIN 2IF RECNUM= 0 THEN 5RECNUM:= CURRECNUM; 2LOCATE(BLOCKED, RECNUM, RECLEN, BLKLEN, 0, ;BLKLEN* NUMHDRBLKS, ;BLKNUM, BYTENUM); 2IF FORCE OR (BLKNUM<> CURRECBLK) THEN 5FORCEWRITE(FVAR, PFPARS); ) END; (* WITH DRPUT THEN 5PUTHDR(FVAR, PFPARS); /END; (* WITH *) )END; (* OF FORCEWRITE *) & &PROCEDURE TESTREC(VAR FVAR: FILEVAR; PFPARS: PFILEPARS; :RECNUM: INTEGER; FORCE: BOOLEAN; :VAR BLKNUM, BYTENUM: INTEGER); )BEGIN (* TESTREC *) 8IF (CURRECBLK+ NUMRECBLKS- 1)> LASTBLK THEN ;NUMTOWRITE:= LASTBLK- CURRECBLK+ 1 8ELSE ;NUMTOWRITE:= NUMRECBLKS; 8BLKIO(STORE, FVAR, RECBUF^, NUMTOWRITE, CURRECBLK); 8IF ERRNUM> 0 THEN 8 EXIT(FORCEWRITE); 8RECPUT:= FALSE; 2 END; (* IF *) 2IF H IF *) 5END; (* WITH *) /END; (* WITH *) )END; (* OF OPENFILE *) ) &PROCEDURE FORCEWRITE(*VAR FVAR: FILEVAR; PFPARS: PFILEPARS*); )VAR ,NUMTOWRITE .: INTEGER; )BEGIN (* FORCEWRITE *) ,WITH PFPARS^, FHDR.PARS^ DO /BEGIN 2IF RECPUT THEN 5BEGIN GNUMRECBLKS, TMPINT); >NEW(RECBUF); >IF NOT BLOCKED THEN ABEGIN DIF ((BLKLEN MOD RECLEN)> 0) AND H(NUMHDRBLKS+ NUMRECBLKS< LASTBLK) THEN GNUMRECBLKS:= NUMRECBLKS+ 1; DFOR TMPINT:= 1 TO NUMRECBLKS- 1 DO GNEW(TMPPTR); ; END; (* IF *) ;END; (*WED, RECLEN, BLKLEN, 0, G(NUMHDRBLKS+ 1)* BLKLEN, GLASTBLK, TMPINT); >LOCATE(FALSE, RECLEN, 1, BLKLEN, 0, TMPINT- 1, GADDLBLKS, TMPINT); >LASTBLK:= LASTBLK+ ADDLBLKS; >NUMHDRBLKS:= NUMHDRBLKS+ 1; >LOCATE(FALSE, RECLEN, 1, BLKLEN, 0, BLKLEN, K; 8CURRECNUM:= 0; 8CURRECBLK:= -1; 8NUMRECBLKS:= 0; 8NUMHDRBLKS:= 0; 8LASTBLK:= 0; 8DISPLBITS:= DISPLACE* 8; 8IF MAXALLOWED> 0 THEN ;BEGIN >LOCATE(FALSE, MAXALLOWED, 1, BITSPERBLK, G96, DISPLBITS, GNUMHDRBLKS, TMPINT); >LOCATE(BLOCKED, MAXALLOERBLK:= BLKLEN DIV RECLEN; 8LASTACTHDR:= ACTHDR; 8NUMINFILE:= NUMINBLK; 8WHILE CURHDRBLK< LASTACTHDR DO ;BEGIN >GETHDR(FVAR, PFPARS, CURHDRBLK+ 1); >IF ERRNUM> 0 THEN AEXIT(OPENFILE); >NUMINFILE:= NUMINFILE+ NUMINBLK; ;END; 8LASTINFILE:= LASTINBL,(* INITIALIZE THE FILE GLOBALS, HEADER, AND RECORD INFO *) ,NEW(PFPARS); ,WITH PFPARS^ DO /BEGIN 2NEW(FHDR.BUF); 2HDRPUT:= FALSE; 2GETHDR(FVAR, PFPARS, 0); 2IF ERRNUM> 0 THEN 5EXIT(OPENFILE); 2WITH FHDR.PARS^ DO 5BEGIN 8RECPUT:= FALSE; 8RECSPING*); )VAR ,ADDLBLKS, ,TMPINT .: INTEGER; ,TMPPTR /: PCHARBLK; )BEGIN (* OPENFILE *) , ,(* OPEN THE FILE *) ,(*$I-*) ,RESET(FVAR, FILENAME); ,(*$I+*) ,ERRNUM:= IORESULT; ,IF ERRNUM> 0 THEN /EXIT(OPENFILE); , XIT(GETGLOBALS); 2 END; (* IF *) 2MOVELEFT(FHDR.BUF, TMPINT, 2); 2TMPINT:= TMPINT+ 12; 2MOVELEFT(TMPINT, HDRPTR, 2); ) END; (* WITH *) )END; (* OF GETGLOBALS *) & &PROCEDURE OPENFILE(*VAR FVAR: FILEVAR; VAR PFPARS: PFILEPARS;  0 THEN 5BEGIN 8GETHDR(FVAR, PFPARS, 0); 2 IF ERRNUM> 0 THEN ;E;EXIT(GETHDR); 2 END; (* IF *) 2BLKIO(RETRIEVE, FVAR, FHDR.BUF^, 1, HDRBLKNUM); 2IF ERRNUM> 0 THEN 5EXIT(GETHDR); 2CURHDRBLK:= HDRBLKNUM; /END; (* WITH *) )END; (* OF GETHDR *) & &PROCEDURE GETGLOBALS(*VAR FVAR: FILEVAR; PFPARS: PFILEPARS; =VAPFPARS: PFILEPARS; 9HDRBLKNUM: INTEGER); )(* ** GET THE SPECIFIED HEADER BLOCK FOR FILE FVAR ** **) & BEGIN (* GETHDR *) ) WITH PFPARS^, FHDR.PARS^ DO /BEGIN 2IF HDRPUT THEN 5BEGIN 8PUTHDR(FVAR, PFPARS); 2 IF ERRNUM> 0 THEN *) & END; (* OF TESTREC *) & &PROCEDURE GETREC(*VAR FVAR: FILEVAR; PFPARS: PFILEPARS; RECNUM: INTEGER; 9RECPTR: PCHARBLK*); )VAR ,BLKNUM, ,BYTENUM, ,NUMTOREAD, ,TMPINT .: INTEGER; , )BEGIN (* GETREC *) ,TESTREC(FVAR, PFPARS, RECNUM, FALSE, BLKNUM, BYTENUM); ,IF ERRNUM> 0 THEN /EXIT(GETREC); ,WITH PFPARS^, FHDR.PARS^ DO /BEGIN 2IF (BLKNUM<> CURRECBLK) THEN 5BEGIN 8IF (BLKNUM+ NUMRECBLKS- 1)> LASTBLK THEN ;NUMTOREAD:= LASTBLK- BLKNUM+ 1 8ELSE ;NUMTOREAD:= NUMRECBLKS; 8BLKIO(RETRIEVE,2IF STATMAP THEN 2 BEGIN 8LOCATE(FALSE, RECNUM, 1, BITSPERBLK, 96, DISPLBITS, AHDRBLKNUM, BITNUM); 8IF CURHDRBLK<> HDRBLKNUM THEN ;BEGIN >GETHDR(FVAR, PFPARS, HDRBLKNUM); 8 IF ERRNUM> 0 THEN AEXIT(CHANGEHDR); ;END; (* IF *) 8STATCHG:= FHDFPARS: PFILEPARS; ;RECNUM: INTEGER; STATUS: RECSTATUS; ;FORCE: BOOLEAN*); )VAR ,BITNUM, ,CHANGENUM, ,FIRSTBIT, ,HDRBLKNUM, ,PREVHDR /: INTEGER; ) STATCHG /: BOOLEAN; )BEGIN (* CHANGEHDR *) ) WITH PFPARS^, FHDR.PARS^ DO /BEGIN TMPRECNUM:= TMPRECNUM+ 1; PBITNUM:= BITNUM+ 1; MEND; (* IF *) GUNTIL BITNUM> ENDBIT; DEND; (* IF *) >UNTIL HDRBLKNUM= LASTHDRBLK; ;END; (* IF *) 5END; (* IF *) /END; (* WITH *) )END; (* OF FINDNEXT *) ) &PROCEDURE CHANGEHDR(*VAR FVAR: FILEVAR; P BITS IN BLOCK *) DBEGIN GIF CURHDRBLK= LASTHDRBLK THEN JENDBIT:= LASTBITNUM GELSE JENDBIT:= BITSPERBLK; GREPEAT JIF FHDR.STAT^[BITNUM]= STATUS THEN MBEGIN PRECNUM:= TMPRECNUM; PEXIT(FINDNEXT); MEND JELSE M(* STATUS DOESN'T MATCH *) MBEGIN PGGETHDR(FVAR, PFPARS, HDRBLKNUM); A IF ERRNUM> 0 THEN JEXIT(FINDNEXT); A END; (* IF *) ABITSINBLK:= BITSPERBLK- BITNUM+ 1; AIF ((STATUS= INACTIVE) GAND (NUMINBLK< BITSINBLK)) FOR ((STATUS= ACTIVE) LAND (NUMINBLK> 0)) CTHEN D(* NO MATCHINGSEARCH *) >LOCATE(FALSE, TMPINT, 1, BITSPERBLK, 96, GDISPLBITS, LASTHDRBLK, LASTBITNUM); >(* FIND STARTING MAP POSITION *) >REPEAT ALOCATE(FALSE, TMPRECNUM, 1, BITSPERBLK, 96, JDISPLBITS, HDRBLKNUM, BITNUM); AIF CURHDRBLK<> HDRBLKNUM THEN DBEGIN HEN ;RECNUM:= NUMINFILE+ 1 8ELSE ;IF TMPRECNUM<= NUMINFILE THEN >RECNUM:= TMPRECNUM; 5END 2ELSE 5BEGIN 8IF STATUS= INACTIVE THEN ;TMPINT:= MAXALLOWED 8ELSE ;TMPINT:= LASTINFILE; 8IF TMPRECNUM<= TMPINT THEN 8 BEGIN >(* FIND LAST POSITION TO , ,HDRBLKNUM, ,LASTBITNUM, ,LASTHDRBLK, ,TMPINT, ,TMPRECNUM .: INTEGER; )BEGIN (* FINDNEXT *) ,WITH PFPARS^, FHDR.PARS^ DO /BEGIN 2TMPRECNUM:= RECNUM+ 1; 2RECNUM:= 0; 2IF NOT STATMAP THEN 5(* ALL RECORDS USED *) 5BEGIN 8IF STATUS= INACTIVE T8STATUSOF:= FHDR.STAT^[BITNUM]; ) END; (* IF *) ) END; (* WITH *) )END; (* OF STATUSOF *) ) &PROCEDURE FINDNEXT(*VAR FVAR: FILEVAR; PFPARS: PFILEPARS;  HDRBLKNUM THEN ;BEGIN >GETHDR(FVAR, PFPARS, HDRBLKNUM); 8 IF ERRNUM> 0 THEN AEXIT(STATUSOF); ;END; (* IF *) *) ) &FUNCTION STATUSOF(*VAR FVAR: FILEVAR; PFPARS: PFILEPARS;  0 THEN /EXIT(CLOSEFILE); ,(*$I-*) ,CLOSE(FVAR, LOCK); ) (*$I+*) ) ERRNUM:= IORESULT; )END; (* OF CLOSEFILE)END; (* OF GETREC *) & &PROCEDURE PUTREC(*VAR FVAR: FILEVAR; PFPARS: PFILEPARS; FORCE: BOOLEAN*); )VAR ,BLKNUM, ,BYTENUM .: INTEGER; )BEGIN (* PUTREC *) ,PFPARS^.RECPUT:= TRUE; ,TESTREC(FVAR, PFPARS, 0, FORCE, BLKNUM, BYTENUM); )END; (* OF PUTR FVAR, RECBUF^, NUMTOREAD, BLKNUM); 8IF ERRNUM> 0 THEN ;EXIT(GETREC); 8CURRECBLK:= BLKNUM; 5END; (* IF *) 2MOVELEFT(RECBUF, TMPINT, 2); 2TMPINT:= TMPINT+ BYTENUM- 1; 2MOVELEFT(TMPINT, RECPTR, 2); 2CURRECNUM:= RECNUM; ) END; (* WITH *) R.STAT^[BITNUM]<> STATUS; 2 END 2ELSE 5(* NO STATUS MAP *) 5STATCHG:= TRUE; 2IF STATCHG THEN 5(* STATUS HAS CHANGED *) 5BEGIN 8HDRPUT:= TRUE; 8CHANGENUM:= ORD(STATUS= ACTIVE)- ORD(STATUS= INACTIVE); 8NUMINBLK:= NUMINBLK+ CHANGENUM; 8NUMINFILE:= NUMINFILE+ CHANGENUM; 8IF STATMAP THEN ;BEGIN >FHDR.STAT^[BITNUM]:= STATUS; >PREVHDR:= LASTACTHDR; >IF NUMINBLK= 0 THEN ALASTINBLK:= 0 >ELSE AIF (LASTINBLK< RECNUM) GAND (STATUS= ACTIVE) THEN D(* LASTINBLK INCREASED *) DLASTINBLK:= RECNUM AELORD -PAGEPTR: PPAGE; -INDEX: INTEGER; -END; (* RECORD *) & &TREEPARS (= RECORD -CURINDEX, -KEYLEN, -MINPERPAGE, -PAGELEN, -NUMONSTACK /: INTEGER; -ROOT, -CURPAGE, -REUSABLE /: PPAGE; -STACK /: ARRAY[1..10] OF STACKITEM; -END; (* RECORD *XTGE); & &PPAGE (= ^PAGE; & &INDIVKEY (= RECORD -RGTSUBTREE: PPAGE; -KEY: STRING[16]; -END; (* RECORD *) , &PAGE (= RECORD -NUMONPAGE: INTEGER; -LFTSUBTREE: PPAGE; -KEYS: PACKED ARRAY[1..2] OF CHAR; -END; (* RECORD *) 0 &STACKITEM (= REC  (*$S+*) (* Swapping option required for UNITs *)  (*$V-*)  UNIT BTREE; INTRINSIC CODE 17; #(* $* B-TREE SEARCH, INSERTION AND DELETION $* $*)  INTERFACE #USES % APPLESTUFF, &GENUTIL; # #TYPE &SRCHTYPE (= (FIRSTEQ, +FIRSTGE, +NEXTEQ, +NEcefghiN^Sע* IF *) DIF NUMINFILE= 0 THEN GLASTACTHDR:= -1; DACTHDR:= LASTACTHDR; DFORCE:= TRUE; AEND; (* IF *) 8 END; (* IF *) 8IF FORCE THEN 5 PUTHDR(FVAR, PFPARS); 5END; (* IF *) ) END; (* WITH *) )END; (* OF CHANGEHDR *) ) R= CURHDRBLK THEN ALASTINFILE:= LASTINBLK; >IF (PREVHDR<> LASTACTHDR) THEN A(* THE NUMBER OF THE LAST ACTIVE HEADER FHAS CHANGED *) ABEGIN DIF CURHDRBLK<> 0 THEN GBEGIN JGETHDR(FVAR, PFPARS, 0); D IF ERRNUM> 0 THEN MEXIT(CHANGEHDR); GEND; (* LASTACTHDR MAY HAVE DECREASED *) DBEGIN GWHILE (CURHDRBLK> 0) AND (NUMINBLK= 0) DO JBEGIN MGETHDR(FVAR, PFPARS, CURHDRBLK- 1); G IF ERRNUM> 0 THEN PEXIT(CHANGEHDR); G END; (* WHILE *) GLASTACTHDR:= CURHDRBLK; DEND; (* IF *) >IF LASTACTHDPBITNUM:= BITNUM- 1; PRECNUM:= RECNUM- 1; MEND; (* WHILE *) JLASTINBLK:= RECNUM; GEND; (* IF *) >IF (LASTACTHDR< CURHDRBLK) DAND (STATUS= ACTIVE) THEN A(* LASTACTHDR INCREASED *) ALASTACTHDR:= CURHDRBLK >ELSE AIF (LASTACTHDR= CURHDRBLK) THEN D(SE DIF (RECNUM= LASTINBLK) JAND (STATUS= INACTIVE) THEN G(* LASTINBLK DECREASED *) GBEGIN J(* FIND PREVIOUS ACTIVE RECORD *) JFIRSTBIT:= L97+ DISPLBITS* ORD(CURHDRBLK= 0); JWHILE (BITNUM> FIRSTBIT) AND S(FHDR.STAT^[BITNUM]<> ACTIVE) SDO MBEGIN ) # #PROCEDURE OPENTREE(VAR TREE: TREEPARS; KEYLENGTH, MINONPAGE: INTEGER); #FUNCTION FINDKEY(VAR TREE: TREEPARS; SRCHVAL: STRING; SRCHKIND: SRCHTYPE; 6VAR FOUNDKEY: STRING) ,: BOOLEAN; #PROCEDURE INSERTKEY(VAR TREE: TREEPARS; SRCHVAL: STRING); #PROCEDURE DELETEKEY(VAR TREE: TREEPARS; SRCHVAL: STRING);   IMPLEMENTATION #TYPE &FUNCTYPE (= (INSKEY, +DELKEY, +SRCHKEY); +  (*$I PUTLIB:BTREE2.TEXT*)  &PROCEDURE CHGPTR(WHICHWAY: DIRECTION; SRCPAGE: PPAGE; KEYNUMBER: INTEGER; NEW(TWOBYTES); 8END 5ELSE 8BEGIN ;EMPTYPAGE:= REUSABLE; ;REUSABLE:= EMPTYPAGE^.LFTSUBTREE; 8END; (* IF *) 2END; (* WITH *) ,END; (* OF NEWPAGE *) # )P & &PROCEDURE DOINSERT; )VAR ,HEIGHTCHG .: BOOLEAN; ,LFTPAGE .: PPAGE; ,EMERGENT .: INDIVKEY; )PROCEDURE NEWPAGE(VAR EMPTYPAGE: PPAGE); ,VAR /TMPINT 1: INTEGER; /TWOBYTES 1: ^INTEGER; ,BEGIN (* NEWPAGE *) /WITH TREE DO 2BEGIN AGE THEN GCURPAGE:= NIL; APUSH; >END; (* IF *) 8UNTIL ENDREPEAT; 8DOFIND:= FOUND; 8IF FOUND THEN ;BEGIN >MOVEKEY(RETRIEVE, CURPAGE, CURINDEX, TMPKEY); >FOUNDKEY:= TMPKEY.KEY; ;END; (* IF *) 5END; (* IF *) /END; (* WITH *) )END; (* OF DOFIND *)JFOUND:= CURPAGE<> NIL; JIF FOUND THEN MBEGIN PMOVEKEY(RETRIEVE, CURPAGE, ZCURINDEX, TMPKEY); PFOUND:= RCOMPAREKEY(TMPKEY); MEND; (* IF *) GEND; (* IF *) >END ;ELSE >(* LFTPAGE<> NIL *) >BEGIN AIF NOT FOUND THEN DIF CURINDEX= CURPAGE^.NUMONP2IF CURPAGE= NIL THEN 5DOFIND:= FALSE 2ELSE 5BEGIN 8ENDREPEAT:= FALSE; 8REPEAT ;FOUND:= SEQSRCH(CURPAGE, MCURINDEX, LFTINDEX, MLFTPAGE); ;IF LFTPAGE= NIL THEN >BEGIN AENDREPEAT:= TRUE; AIF NOT FOUND THEN DIF NUMONSTACK> 0 THEN GBEGIN JPOP; TIL (CURPAGE<> NIL) OR (NUMONSTACK= 0); ,END; (* OF POP *) ) )BEGIN (* DOFIND *) ,WITH TREE DO /BEGIN 2IF (SRCHKIND= FIRSTEQ) OR (SRCHKIND= FIRSTGE) THEN 5BEGIN 8CURPAGE:= ROOT; 8CURINDEX:= 0; 8NUMONSTACK:= 0; 5END; (* IF *) LFTPAGE; 5CURINDEX:= 0; 2END; (* WITH *) ,END; (* OF PUSH *) ) )PROCEDURE POP; ,BEGIN (* POP *) /WITH TREE DO 2REPEAT 5WITH STACK[NUMONSTACK] DO 8BEGIN ;CURPAGE:= PAGEPTR; ;CURINDEX:= INDEX; 8END; (* WITH *) 5NUMONSTACK:= NUMONSTACK- 1; 2UN.: PPAGE; ,LFTINDEX .: INTEGER; ,TMPKEY .: INDIVKEY; ) )PROCEDURE PUSH; ,BEGIN (* PUSH *) /WITH TREE DO 2BEGIN 5NUMONSTACK:= NUMONSTACK+ 1; 5WITH STACK[NUMONSTACK] DO 8BEGIN ;PAGEPTR:= CURPAGE; ;INDEX:= CURINDEX; 8END; (* WITH *) 5CURPAGE:=2ELSE 5BEGIN 8MOVEKEY(RETRIEVE, CURPAGE, LFTINDEX, TMPKEY); 8LFTPAGE:= TMPKEY.RGTSUBTREE; 5END; (* IF *) 2SEQSRCH:= FOUND; /END; (* WITH *) )END; (* OF SEQSRCH *) # &FUNCTION DOFIND /: BOOLEAN; )VAR ,ENDREPEAT, ,FOUND .: BOOLEAN; ,LFTPAGE MPKEY); 8FOUND:= :COMPAREKEY(TMPKEY); 8ENDWHILE:= TRUE; 8IF NOT FOUND THEN ;IF SRCHVAL> TMPKEY.KEY THEN >BEGIN ALFTINDEX:= LFTINDEX+ 1; AENDWHILE:= (KEYINDEX= NUMONPAGE); >END; 5END; (* WHILE *); 2IF LFTINDEX= 0 THEN 5LFTPAGE:= LFTSUBTREE BOOLEAN; ,TMPKEY .: INDIVKEY; )BEGIN (* SEQSRCH *) ,WITH CURPAGE^ DO /BEGIN 2LFTINDEX:= KEYINDEX; 2FOUND:= FALSE; 2ENDWHILE:= (KEYINDEX= NUMONPAGE); 2WHILE NOT ENDWHILE DO 5BEGIN 8KEYINDEX:= KEYINDEX+ 1; 8MOVEKEY(RETRIEVE, CURPAGE, KEYINDEX, T*) 2END; (* WITH *) )END; (* OF MOVE *) ) &FUNCTION SEQSRCH(CURPAGE: PPAGE; 9VAR KEYINDEX, LFTINDEX: INTEGER; 9VAR LFTPAGE: PPAGE) 0: BOOLEAN; )(* ** SEQUENTIAL SEARCH FOR KEY MATCHING SRCHVAL ON PAGE CURPAGE ** **) )VAR ,ENDWHILE, ,FOUND .:5DSTPOS:= 1+ KEYLEN* (DSTINDEX- 1); 5MOVELEN:= NUMENTRIES* KEYLEN; 5(*$R-*) 5IF SRCPOS> DSTPOS THEN 8MOVELEFT(SRCPAGE^.KEYS[SRCPOS], DSTPAGE^.KEYS[DSTPOS], CMOVELEN) 5ELSE 8MOVERIGHT(SRCPAGE^.KEYS[SRCPOS], DDSTPAGE^.KEYS[DSTPOS], MOVELEN); 5(*$R+GE: PPAGE; SRCINDEX: INTEGER; 7DSTPAGE: PPAGE; DSTINDEX: INTEGER; 7NUMENTRIES: INTEGER); )VAR ,SRCPOS, ,DSTPOS, ,MOVELEN .: INTEGER; )BEGIN (* MOVE *) ,WITH TREE DO /IF NUMENTRIES> 0 THEN 2BEGIN 5SRCPOS:= 1+ KEYLEN* (SRCINDEX- 1); ROCEDURE SEARCH(NEWROOT: PPAGE; VAR HEIGHTCHG: BOOLEAN; NUMONPAGE:= 1; >LFTSUBTREE:= LFTPAGE; >MOVEKEY(STORE, ROOT, 1, EMERGENT); ;END; (* WITH *) 5END; (* IF *) = FALSE 8ELSE ;(* KEY NOT FOUND ON CURRENT PAGE *) ;BEGIN >SEARCH(LFTPAGE, HEIGHTCHG, EMERGENT); >IF HEIGHTCHG THEN AKEYINSERT; ;END; (* IF *) 5END; (* WITH *) ,END; (* OF SEARCH *) )BEGIN (* DOINSERT *) ,WITH TREE DO /BEGIN 2SEARCH(ROOT, HEIGE *) 5 5HEIGHTCHG:= TRUE; 5WITH INSEMERGE DO 8BEGIN ;KEY:= SRCHVAL; ;RGTSUBTREE:= NIL; 8END; (* WITH *) 2END /ELSE 2WITH NEWROOT^ DO 5BEGIN 8KEYINDEX:= 0; 8FOUND:= SEQSRCH(NEWROOT, JKEYINDEX, LFTINDEX, JLFTPAGE); 8IF FOUND THEN ;HEIGHTCHG:>ADJPAGE^.LFTSUBTREE:= INSEMERGE.RGTSUBTREE; >INSEMERGE.RGTSUBTREE:= ADJPAGE; ;END; (* IF *) 5END; (* WITH *) /END; (* OF KEYINSERT *) , ,BEGIN (* SEARCH *) /IF NEWROOT= NIL THEN 2(* KEY MATCHING SRCHVAL WAS NOT FOUND *) 2BEGIN 5 5(* NOT IN TRE); DMOVEKEY(STORE, ADJPAGE, LFTINDEX, NEMERGENT); DMOVE(NEWROOT, KLFTINDEX+ 1+ MINPERPAGE, KADJPAGE, LFTINDEX+ 1, KMINPERPAGE- LFTINDEX); AEND; (* IF *) >NUMONPAGE:= MINPERPAGE; >ADJPAGE^.NUMONPAGE:= MINPERPAGE; OT, MINPERPAGE+ 1, KADJPAGE, 1, MINPERPAGE); AEND >ELSE A(* INSERT EMERGENT IN RIGHT PAGE *) ABEGIN DLFTINDEX:= LFTINDEX- MINPERPAGE; DMOVEKEY(RETRIEVE, NNEWROOT, MINPERPAGE+ 1, NINSEMERGE); DMOVE(NEWROOT, MINPERPAGE+ 2, KADJPAGE, 1, LFTINDEX- 1GE THEN GINSEMERGE:= EMERGENT DELSE GBEGIN JMOVEKEY(RETRIEVE, TNEWROOT, MINPERPAGE, TINSEMERGE); JMOVE(NEWROOT, LFTINDEX+ 1, QNEWROOT, LFTINDEX+ 2, QMINPERPAGE- LFTINDEX- 1); JMOVEKEY(STORE, NEWROOT, LFTINDEX+ 1, TEMERGENT); GEND; DMOVE(NEWROENUMONPAGE- LFTINDEX- 1); >MOVEKEY(STORE, NEWROOT, LFTINDEX+ 1, EMERGENT); ;END 8ELSE ;(* PAGE NEWROOT^ IS FULL; @SPLIT IT AND ASSIGN EMERGENT TO INSEMERGE *) ;BEGIN >NEWPAGE(ADJPAGE); >IF LFTINDEX<= MINPERPAGE THEN ABEGIN DIF LFTINDEX= MINPERPANEWROOT^ DO 5BEGIN 8IF NUMONPAGE< (2* MINPERPAGE) THEN ;(* INSERT NEW ENTRY TO THE RIGHT OF @NEWROOT^.KEYENTRY[LFTINDEX] *) ;BEGIN >NUMONPAGE:= NUMONPAGE+ 1; >HEIGHTCHG:= FALSE; >MOVE(NEWROOT, LFTINDEX+ 1, ENEWROOT, LFTINDEX+ 2, ;CHGPTR(RIGHT, NEWROOT, MINPERPAGE, DADJPAGE^.LFTSUBTREE); ;IF KEYINDEX> 0 THEN >BEGIN AMOVE(ADJPAGE, 1, HNEWROOT, 1+ MINPERPAGE, HKEYINDEX- 1); AMOVE(ADJPAGE, KEYINDEX, HANCESPAGE, LASTONPAGE, 1); ACHGPTR(RIGHT, ANCESPAGE, LASTONPAGE, ADJPAGE); ACHGPTR(LEFT, ADJPAGE, KEYINDEX, ADJPAGE); ANUMONADJ:= NUMONADJ- KEYINDEX; AMOVE(ADJPAGE, 1+ KEYINDEX, HADJPAGE, 1, NUMONADJ); AADJPAGE^.NUMONPAGE:= NUMONADJ; ANEWROOT^.NUMONPAGE:= MINPERPAGE- 1+ KEYINDEX; AHEIGHTCHG:= FALSE; >END ;ELSE >(* MER5BEGIN 8IF ROOT^.NUMONPAGE= 0 THEN ;(* CHANGE ROOT *) ;BEGIN >LFTPAGE:= ROOT; >ROOT:= LFTPAGE^.LFTSUBTREE; >(* DISPOSE LFTPAGE *) >RECYCLE(LFTPAGE); ;END; (* IF *) 5END; (* IF *) /END; (* WITH *) )END; (* OF DODELETE *) & &BEGIN (* DISPATCH *PAGE, HEIGHTCHG); ;IF HEIGHTCHG THEN >UNDERFLOW(NEWROOT, JLFTPAGE, LFTINDEX, HEIGHTCHG); 8END; (* IF *) 2END; (* WITH *) ,END; (* OF KEYDELETE *) , )BEGIN (* DODELETE *) ,WITH TREE DO /BEGIN 2KEYDELETE(ROOT, HEIGHTCHG); 2IF HEIGHTCHG THEN PAGE; AMOVE(NEWROOT, KEYINDEX+ 1, HNEWROOT, KEYINDEX, HNUMONPAGE- KEYINDEX+ 1); >END ;ELSE >BEGIN ADEL(LFTPAGE, HEIGHTCHG); AIF HEIGHTCHG THEN DUNDERFLOW(NEWROOT, LFTPAGE, LFTINDEX, PHEIGHTCHG) >END; (* IF *) 8END 5ELSE 8BEGIN ;KEYDELETE(LFTWITH TREE, NEWROOT^ DO 2BEGIN 5KEYINDEX:= 0; 5FOUND:= SEQSRCH(NEWROOT, GKEYINDEX, LFTINDEX, GLFTPAGE); 5IF FOUND THEN 8(* DELETE KEYENTRY[KEYINDEX] *) 8BEGIN ;IF LFTPAGE= NIL THEN >BEGIN ANUMONPAGE:= NUMONPAGE- 1; AHEIGHTCHG:= NUMONPAGE< MINPERENEWROOT, KEYINDEX, 1); >NUMONPAGE:= NUMONPAGE- 1; >HEIGHTCHG:= NUMONPAGE< MINPERPAGE; ;END; (* IF *) 5END; (* WITH *) /END; (* OF DEL *) 5 )BEGIN (* KEYDELETE *) ,IF NEWROOT= NIL THEN / /(* KEY IS NOT IN TREE *) / /HEIGHTCHG:= FALSE ,ELSE /, LFTPAGE, NUMONPAGE, MHEIGHTCHG); ;END 8ELSE ;(* TAKE KEYENTRY FROM LFTPAGE *) ;BEGIN >MOVEKEY(RETRIEVE, NEWROOT, KEYINDEX, TMPKEY); >CHGPTR(RIGHT, RGTSUBTREE, NUMONPAGE, KTMPKEY.RGTSUBTREE); >MOVE(RGTSUBTREE, NUMONPAGE, KEY 4: INDIVKEY; /BEGIN (* DEL *) 2WITH TREE, RGTSUBTREE^ DO 5BEGIN 8MOVEKEY(RETRIEVE, RGTSUBTREE, NUMONPAGE, TMPKEY); 8LFTPAGE:= TMPKEY.RGTSUBTREE; 8IF LFTPAGE<> NIL THEN ;BEGIN >DEL(LFTPAGE, HEIGHTCHG); >IF HEIGHTCHG THEN AUNDERFLOW(RGTSUBTREESPOSE NEWROOT *) ARECYCLE(NEWROOT); AHEIGHTCHG:= ANCESPAGE^.NUMONPAGE< MINPERPAGE; >END; (* IF *) 8END; (* IF *) 2END; (* WITH *) /END; (* OF UNDERFLOW *) / ,PROCEDURE DEL(RGTSUBTREE: PPAGE; VAR HEIGHTCHG: BOOLEAN); /VAR 2LFTPAGE 4: PPAGE; 2TMPAMOVE(ANCESPAGE, LASTONPAGE, ADJPAGE, NUMONADJ, H1); ACHGPTR(RIGHT, ADJPAGE, NUMONADJ, MNEWROOT^.LFTSUBTREE); AMOVE(NEWROOT, 1, ADJPAGE, 1+ NUMONADJ, HMINPERPAGE- 1); AADJPAGE^.NUMONPAGE:= 2* MINPERPAGE; AANCESPAGE^.NUMONPAGE:= NUMONANC- 1; A(* DIACHGPTR(RIGHT, ANCESPAGE, LASTONPAGE, NEWROOT); AADJPAGE^.NUMONPAGE:= NUMONADJ- 1; ANEWROOT^.NUMONPAGE:= MINPERPAGE- 1+ KEYINDEX; AHEIGHTCHG:= FALSE; >END ;ELSE >(* MERGE ADJPAGE^ AND NEWROOT^ *) >BEGIN EX, 1); ACHGPTR(RIGHT, NEWROOT, KEYINDEX, MNEWROOT^.LFTSUBTREE); ANUMONADJ:= NUMONADJ- KEYINDEX; AMOVE(ADJPAGE, 1+ NUMONADJ, HNEWROOT, 1, KEYINDEX- 1); ACHGPTR(LEFT, ADJPAGE, NUMONADJ, NEWROOT); AMOVE(ADJPAGE, LASTONPAGE, ADJPAGE, NUMONADJ, H1); AGE:= TMPKEY.RGTSUBTREE; >END; (* IF *) ;NUMONADJ:= ADJPAGE^.NUMONPAGE+ 1; ;KEYINDEX:= (NUMONADJ- MINPERPAGE) DIV 2; ;IF KEYINDEX> 0 THEN >BEGIN AMOVE(NEWROOT, 1, NEWROOT, 1+ KEYINDEX, HMINPERPAGE- 1); AMOVE(ANCESPAGE, LASTONPAGE, HNEWROOT, KEYINDA(* DISPOSE ADJPAGE *) ARECYCLE(ADJPAGE); AHEIGHTCHG:= ANCESPAGE^.NUMONPAGE< MINPERPAGE; >END; 8END 5ELSE 8BEGIN ;IF LASTONPAGE= 1 THEN >ADJPAGE:= ANCESPAGE^.LFTSUBTREE ;ELSE >BEGIN AMOVEKEY(RETRIEVE, KANCESPAGE, LASTONPAGE- 1, TMPKEY); AADJPGE ADJPAGE^ AND NEWROOT^ *) >BEGIN AMOVE(ADJPAGE, 1, NEWROOT, 1+ MINPERPAGE, IMINPERPAGE); AMOVE(ANCESPAGE, LASTONPAGE+ 1, HANCESPAGE, LASTONPAGE, HNUMONANC- LASTONPAGE); ANEWROOT^.NUMONPAGE:= 2* MINPERPAGE; AANCESPAGE^.NUMONPAGE:= NUMONANC- 1; ) )DISPATCH:= FALSE; )FOUNDKEY:= NULLSTRG; )CASE ACTION OF ,SRCHKEY: DISPATCH:= DOFIND; ,INSKEY: DOINSERT; ,DELKEY: DODELETE; ,END; (* CASE *) &END; (* DISPATCH *) # #FUNCTION FINDKEY(*VAR TREE: TREEPARS; SRCHVAL: STRING; SRCHKIND: SRCHTYPE; 6VAR FOUNDKEY: STRING) ,: BOOLEAN*); # BEGIN (* FINDKEY *) & FINDKEY:= DISPATCH(SRCHKEY, TREE, SRCHVAL, SRCHKIND, FOUNDKEY); &END; (* OF FINDKEY *) & #PROCEDURE INSERTKEY(*VAR TREE: TREEPARS; SRCHVAL: STRING*); # VAR )TMPBOOL +: BOOLEAN; & T  !TYPE "DSTR8=STRING [8]; "TSTR6=STRING [6]; "SSTR18=STRING [18]; " !FUNCTION PADDLE(SELECT: INTEGER): INTEGER; !FUNCTION BUTTON(SELECT: INTEGER): BOOLEAN; !PROCEDURE JOYSTICK(SELECT: INTEGER; VAR X,Y: INTEGER; VAR B0,B1: BOOLEAN); !FUNCTION KEggbbbb $+DAPPLESTULONGINTIGENUTIL GENUTIL FILEACCEBTREE  (SPONSE, FALSE); )END; (* OF PROMPT *) )(*$R+*) )  (* END OF GENUTIL2.TEXT *)  9TRUNCATE: DOTRUNCATE; :RESTORE: DORESTORE; ;ESCAPE: DOESCAPE; >END; (* CASE *) / END /ELSE 2BEGIN 5CTRLKIND:= NOTCTRL; 5DONOTCTRL; / END; (* IF *) ,UNTIL TERMINATED; ,CHGLEN(RESPONSE, RSPPOS); ,IF NOT (NOECHO IN RSPKIND) THEN /DISPRSP(RE+: STRING[16]; &BEGIN (* DELETEKEY *) & TMPBOOL:= DISPATCH(DELKEY, TREE, SRCHVAL, FIRSTEQ, TMPSTRG); &END; (* OF DELETEKEY *) & #BEGIN (* BTREE *) #END. (* OF BTREE *)   (* END OF BTREE2.TEXT *)  MPSTRG +: STRING[16]; &BEGIN (* INSERTKEY *) & TMPBOOL:= DISPATCH(INSKEY, TREE, SRCHVAL, FIRSTEQ, TMPSTRG); &END; (* OF INSERTKEY *) & #PROCEDURE DELETEKEY(*VAR TREE: TREEPARS; SRCHVAL: STRING*);  VAR )TMPBOOL +: BOOLEAN; & TMPSTRG YPRESS: BOOLEAN; !FUNCTION RANDOM: INTEGER; !PROCEDURE RANDOMIZE; !PROCEDURE NOTE(PITCH,DURATION: INTEGER); !Copyright (C) 1980 Apple Computer] ;Clear the Buffer 0LDA #16. 'b'b)RbPRbRINTEGER R CREAL $X CHAR 6b BOOLEAN fhe STRING P TEXT $vMEINTERACTL|ouINPUT xvSTOUTPUT bv KEYBOARDv0FALSE hTRz Z   :    ( tV8$@hvhwhhxylxh:vwlv8<<+-Í-۲0ݡߑ ع       &  * عteVG8  )   uh[NA4'á NTEGER[36]) /END; ' " "PROCEDURE FREADDEC(VAR F: FIB; VAR D: STUNT; L: INTEGER); "PROCEDURE FWRITEDEC(VAR F: FIB; D: DECMAX; RLENG: INTEGER); "  IMPLEMENTATION L E ^JECommand: E(dit, R(un, F(ile, C(omp, L(ink, X(ecute, A(ssem, $ "TYPE DECMAX = INTEGER[36]; STUNT = RECORD CASE INTEGER OF 12:(W2:INTEGER[4]); 13:(W3:INTEGER[8]); 14:(W4:INTEGER[12]); 15:(W5:INTEGER[16]); 16:(W6:INTEGER[20]); 17:(W7:INTEGER[24]); 18:(W8:INTEGER[28]); 19:(W9:INTEGER[32]); 110:(W10:I qr80bHH`' <<EBi[ZXGFD@2  FdhFd  P  V  STA READe*)eLL`pMK hh hhHH`'6hh  ;C hhȥ ߥHH`  87M9\hhhh᭙0:0D0  !"#$%&'()*+0123456789:;@ABCDEFGHIJKPQRSTUVWXYZ[`abcdefghijkp@=97)('%#  zhh ?hh)HH`*c<`&&&e?L' hhh)?hȼhhhhHH`hhhhWV) ) 02@*P"`pL&&&LFfFfFfFfHH`P.AUDIO,d`hXȑhhWȑhhHH`_`O?/!hhhhhh9.:.;.<0(0(099JH;HHH`Z310/$ Thh   MyMz { | y z {U|HH`A<62,('&% `hh hhhhhhh)h' 1H)/HHH`,d+`,+#Lhhhhhhh)h) YH)U)HHH` !<hhi )n YhhV)ȑhhU)ȑhUE hxNIL :pMAXINT |RRKBYTESTREWORDSTRE .WOR 0BN DY  P  V  STA READ!PROCEDURE SOUND(PITCH,DURATION,VOLUME: INTEGER); !PROCEDURE DATE(VAR D: DSTR8); !PROCEDURE TIMEOFDAY(VAR T: TSTR6); !PROCEDURE CLOCKINFO(VAR YR,MON,DAY,DAYOFWK,HR,MIN,SEC,THOU: INTEGER); !PROCEDURE SETTIME(T: SSTR18); !  IMPLEMENATION E TRUE hxNIL :pMAXINT |RRKBYTESTREWORDSTRE .WOR 0BN DY  P  V  STA READ==` 5l 5 l 5lhzh{hƁhhhƁ}eʆƀƀ|ʊe~8偅z{lzhhhhhh8冐 0 h HHHL,LGIL,h hBCʈ _.ł( Ł|} ŀ}|ƀLV~HHL,~HH~HHHHHHL,~ʈƅFHHHH恥HL,0~}ʈƅ0I愊iʈؚH恥LŁ|} ƅLw ~~8# FUNCTION FIRSTNON(HOWJUST: DIRECTION; PADCHR: CHAR; SRCSTRG: STRING) /: INTEGER; &PROCEDURE EVALUATE(STRG: STRING; VAR VALUE: LONG; VAR CURPOS: INTEGER); # FUNCTION EVALINT(STRG: STRING; VAR CURPOS: INTEGER) /: INTEGER; &PROCEDURE LONGDIV(DIVIDEAN; 9VALIDCHR: CHARSET); &PROCEDURE CHGLEN(VAR STRG: STRING; NEWLEN: INTEGER); &PROCEDURE MAKESTRG(CH: CHAR; VAR STRG: STRING); &PROCEDURE JUSTIFY(SRCSTRG: STRING; VAR DSTSTRG: STRING; :HOWJUST: DIRECTION; PADCHR: CHAR; :NEWLEN: INTEGER); +: PACKED ARRAY[0..255] OF CTRLTYPE; )DATEDELIM +: STRING[1]; )TODAY +: STRING[6]; )REPORTCTRL +: RPTCTRL; )OUTTEXT +: TEXT; & &PROCEDURE DELAY(DURATION: INTEGER); &PROCEDURE SOUNDBELL; # PROCEDURE GETCHR(NUMDELAYS: INTEGER; WITHBELLS: BOOLNER: STRING; 0END; (* RECORD *) & &VAR )BACKGROUND, )ESC, )NULL, )RSPCHR, )RET, )UNDERSCORE +: CHAR; )ESCTYPED +: BOOLEAN; )ERRNUM, )MINDIGITS, )NUMPLACES +: INTEGER; )ALTCHR, )CTRLCHR, )DIGITS, )NORMALCHR, )NULLSET +: CHARSET; )CTRL+= (QUIET, ERROR, WARNING, ATTENTION); + )OUTDEVICE += (PRINTER, SCREEN); * )LINETYPE += (PRINT, SKIP); & )RPTCTRL += RECORD 0PRINTAREA: INTEGER; 0PHYSICAL: INTEGER; 0LINESONPAGE: INTEGER; 0PAGENUMBER: INTEGER; 0OUTPUTTO: OUTDEVICE; 0RPTBAN0..13; 0YEAR: 0..99; 0END; (* RECORD *) & )MSGTYPE :'')PBBINTEGER x tREAL clCHAR ^bBOOLEAN vNESTRING 0EV /COMMAS, /DECIMAL, /DOLLAR, /FIXED, /NOECHO, /NOESC, /NUMERIC, /PARENS, /SIGNED, /TRAILMINUS, /STDDATE, /ABBRMON, /FULLMON, /FULLYEAR, /DMY, /YMD); ) )ATTRIBSET += SET OF ATTRIBUTE; & )DATEINT += PACKED RECORD 0DAY: 0..31; 0MONTH: CHARSET += SET OF CHAR; ) )SCRCOMMAND += (NULLCMD, .CLRLINE, .CLRSCREEN); ) )CTRLTYPE += (NOTCTRL, .DUPCHR, .BACKSPACE, .INSCHR, .BEGFLD, .ENDFLD, .DELCHR, .CLRTOEND, .ACCEPT, .TRUNCATE, .RESTORE, .ESCAPE); & )ATTRIBUTE ,= (ALTONLY, # &USES )APPLESTUFF; ) &CONST )NULLSTRG += ''; )SPACE += ' '; )DASH += '-'; )SCRCOLS += 80; ) &TYPE )ACCESS += (RETRIEVE, .STORE); ) )DIRECTION += (CENTER, 0LEFT, 0DOWN, 0RIGHT, 0UP);  )LONG += INTEGER[12]; + # hhƀ 0ȑƀ0hJJJJ 0ȑ) 0ȑƀĆLOL,3-'~{vvvvvvvvvvvZTNlb3 `\[TOG@;:3(  T[Fc= YP12 &%& FTYP13 &%& FT ei|ʽ 8襁i}ƅ|L,hƀhhh8hohlhXhhhFffff80)ƅܥ#FfII懥HHL,LGhhhhhƀhh-Ȅʈƅ})H揥>ʈƅ ~擥  抦|ɥ8包~ƅLII懩&&u`hh HHHHHL,}ʈƅFyʈƅ}ʈƍƎƋƊЌإL2d|e~28ʈƅyʈƅƉ` _LWŁ|}ƅLwE||怦}ʚH恺8倅偪ƅ  ILL, _LwLL,E0LL _Lw ILL,ELL _LwEe8刅刪ʈʈݒ&~END, DIVISOR: LONG; VAR LQUOTIENT, LREMDR: LONG); &PROCEDURE LOCATE(BLOCKED: BOOLEAN; 9ENTNUM, ENTLEN, PAGELEN, RESRVD, DISPLACE: INTEGER; 9VAR PAGENUM, POSNUM: INTEGER); &PROCEDURE PROMPT(RSPX, RSPY, RSPLEN: INTEGER; DEFAULT: STRING; 8VAR RESPONSE: STRING; 8RSPKIND: ATTRIBSET); &PROCEDURE FMTNUM(RAWSTRG: STRING; VAR FMTSTRG: STRING; 9HOWJUST: DIRECTION; 9MAXLEN: INTEGER; FMTSPECS: ATTRIBSET); &PROCEDURE SCREENMSG(XPOS, YPOS: INTEGER; COMMAND: SCRCOMMAND; =MESSAGE: STRING); &PROCEDURE RESPOND(MSRn+۪P327צ+8 O 28+ 88  888K;88(58;l[43 44˄4,E%52&5á52'P5$5(()52*٪P H*H7H7ءצH HH55ؿ55555á ظ5HP   ! "5ɡ HP"#5HHHP4$5ɡ$5š5 555š55 6-˶Ä%45ɡ 55 5áo356á 5^-5HȡH ^563;5š4á53HP 9K5á2G5á 32 (+-˶5Ä5ء3á ǀR  jعa5ɡ54˶4˶56Í,צ^P5i*zڶšھ 3 5-Äɡ&5š   [ػ;;ٗ خ8 +; K   ȡؗǀIǀBǀEǀDǀCǀA .Zr  ټ< ߡQ ە݆š ݆  M   ە //k00+- ټ00-/0-á -..///.ټZ ۪P. .   .  ܪP0P0š00ˡٞ 0š?ڹ/)0/0/('0/0 zڪPܹ1/01/0 $צ'221á1021/121*Z pڪP.-ȡ,ŕ > $ ؿ ٿINTEGER; ÍVȡڡ  -ܢۤ ܢ ۤ ׷ '(ܢۤ )  ܢ ۤۤ ڡZצFile length - P $to continue áۢ3""ˡ"Zצ I/O error # P0ZצInput file -> PP*צ*SYSTEM.LIBRARYPš3"ˡ#Pצ.CODEUáZڢá[ צType to continue áڢ3Z ۢ צType bbbbbbbbbbbbbbbb(C)Apple Computer Inc. 1979Z PASCALSYLIBRARIA á"ȡ  ۢ Bɡ5 ȡTá  3  Iٚ8 آ آآÍ-:öÍáy ܟá/ړ&šڡ ړá ۡڡPy R  š?šܢڢݞܢڢݞ R ߓ6  ޓ á X r آ ٢آآؚۢۢۢۢۢ.۹ޢޢ #D۹آܚ 2ڨ 0(8"<&&UNDKEY: STRING) ,: BOOLEAN; #PROCEDURE INSERTKEY(VAR TREE: TREEPARS; SRCHVAL: STRING); :'')PBBINTEGER xREAL #CHAR BOOLEAˡ ق!k ٤ ׷ 쥅ؤˡZWARNING - Slot תP + already linked. Please reconfirm (y/n) - ZתPڳ٤á (ɡ(ZצNot enough room to copy slotPhؤh٤ˡ h٤  ȡˡ ZצError reading slot Pˡ+ZI/O error - no room on diskתPؤ٤ؤ&BEGIN (* FILEACCESS INITIALIZATION *) &END. (* OF FILEACCESS INITIALIZATION *)  ɚܕ خ nءá ڢ*ܪPڦתP޹   R6ܪPR تP-,fتP-,fނ ڮ ڮ߂2 ނ ڮɚ nڟˡخخ+ۮ ɚ\ٟá[ ڡ2ݟáɡ  š?  ܮܮߕ߂ޮ ޚ߂/ ٕ ܮɚá  šQ߂  ߕ ضض آؚڟá' ۡ J ءٚ6آ٢ؚ ȡ רצNotice? OצХOҥá  ror H 2    Zצ#Apple /// Pascal Librarian [A3/1.0]PZOutput file -> תP1P1*1צ*SYSTEM.LIBRARYP1á ҥ11 ȡ רצNotice? OצХOҥá  צCode write error H 2    Zצ#Apple /// Pascal Librarian [A3/1.0]PZOutput file -> תP1P1*1צ*SYSTEM.LIBRARYP1á ҥ11 ȡ רצNotice? OצХOҥá  x@@쥀&(*ҥ Zצ#Apple /// Pascal Librarian [A3/1.0]PZOutput file -> תP1P1*1צ*SYSTEM.LIBRARYP1á ҥ11 = for all, ? for select, N(ew file, Q(uit, A(bortתP =á;ZCopying all slots...תPȡڡ?á}ȡl٤šZZ Copy slot תP צ?  ڡ  ˡ RڤťXڤÍ=ګZSlot to copy into? תP = š7á"Z Read error # תPZMSlot # to copy and ,ˡؤX٤ɥX٤ōX٤XؤX٤xؤx٤x٤á% $ХЪOX٤ !N ZצPá  0 $ "TYPE DECMAX = INTEGER[36]; STUNT = RECORD CASE INTEGER OF 12:(W2:INTEGER[4]); 13:(W3:INTEGER[8]); 14:(W4:INTEGER[12]); 15:(W5:INTEGER[16]); 16:(W6:INTEGER[20]); 17:(W7:INTEGER[24]); 18:(W8:INTEGER[28]); 19:(W9:INTEGER[32]); 110:(W10:I qr80bHH`' <<EBi[ZXGFD@2  FdhFd  P  V  STA READe*)eLL`pMK hh hhHH`'6hh  ;C hhȥ ߥHH`  87M9\hhhh᭙0:0D0  !"#$%&'()*+0123456789:;@ABCDEFGHIJKPQRSTUVWXYZ[`abcdefghijkp@=97)('%#  zhh ?hh)HH`*c<`&&&e?L' hhh)?hȼhhhhHH`hhhhWV) ) 02@*P"`pL&&&LFfFfFfFfHH`P.AUDIO,d`hXȑhhWȑhhHH`_`O?/!hhhhhh9.:.;.<0(0(099JH;HHH`Z310/$ Thh   MyMz { | y z {U|HH`A<62,('&% `hh hhhhhhh)h' 1H)/HHH`,d+`,+#Lhhhhhhh)h) YH)U)HHH` !<hhi )n YhhV)ȑhhU)ȑhUE hxNIL :pMAXINT |RRKBYTESTREWORDSTRE .WOR 0BN DY  P  V  STA READ!PROCEDURE SOUND(PITCH,DURATION,VOLUME: INTEGER); !PROCEDURE DATE(VAR D: DSTR8); !PROCEDURE TIMEOFDAY(VAR T: TSTR6); !PROCEDURE CLOCKINFO(VAR YR,MON,DAY,DAYOFWK,HR,MIN,SEC,THOU: INTEGER); !PROCEDURE SETTIME(T: SSTR18); !  IMPLEMENATION E TRUE hxNIL :pMAXINT |RRKBYTESTREWORDSTRE .WOR 0BN DY  P  V  STA READPRbRINTEGER R CREAL $X CHAR 6b BOOLEAN fhe STRING P TEXT $vMEINTERACTL|ouINPUT xvSTOUTPUT bv KEYBOARDv0FALSE hTRɚܕ خ nءá ڢ*ܪPڦתP޹   R6ܪPR تP-,fتP-,fBv@(\,2Rr. ڮɚ nڟˡخخ+ۮ ɚ\ٟá[ ڡ2ݟáNTEGER[36]) /END; ' " "PROCEDURE FREADDEC(VAR F: FIB; VAR D: STUNT; L: INTEGER); "PROCEDURE FWRITEDEC(VAR F: FIB; D: DECMAX; RLENG: INTEGER); "  IMPLEMENTATION L E ^JECommand: E(dit, R(un, F(ile, C(omp, L(ink, X(ecute, A(ssem,  &  * عteVG8  )   uh[NA4'á += (QUIET, ERROR, WARNING, ATTENTION); + )OUTDEVICE += (PRINTER, SCREEN); * )LINETYPE += (PRINT, SKIP); & )RPTCTRL += RECORD 0PRINTAREA: INTEGER; 0PHYSICAL: INTEGER; 0LINESONPAGE: INTEGER; 0PAGENUMBER: INTEGER; 0OUTPUTTO: OUTDEVICE; 0RPTBAN0..13; 0YEAR: 0..99; 0END; (* RECORD *) & )MSGTYPE :'')PBBINTEGER xD;REAL  SCHAR G BOOLEAN v2STRING 0WH /COMMAS, /DECIMAL, /DOLLAR, /FIXED, /NOECHO, /NOESC, /NUMERIC, /PARENS, /SIGNED, /TRAILMINUS, /STDDATE, /ABBRMON, /FULLMON, /FULLYEAR, /DMY, /YMD); ) )ATTRIBSET += SET OF ATTRIBUTE; & )DATEINT += PACKED RECORD 0DAY: 0..31; 0MONTH: CHARSET += SET OF CHAR; ) )SCRCOMMAND += (NULLCMD, .CLRLINE, .CLRSCREEN); ) )CTRLTYPE += (NOTCTRL, .DUPCHR, .BACKSPACE, .INSCHR, .BEGFLD, .ENDFLD, .DELCHR, .CLRTOEND, .ACCEPT, .TRUNCATE, .RESTORE, .ESCAPE); & )ATTRIBUTE ,= (ALTONLY, # &USES )APPLESTUFF; ) &CONST )NULLSTRG += ''; )SPACE += ' '; )DASH += '-'; )SCRCOLS += 80; ) &TYPE )ACCESS += (RETRIEVE, .STORE); ) )DIRECTION += (CENTER, 0LEFT, 0DOWN, 0RIGHT, 0UP);  )LONG += INTEGER[12]; + # hhƀ 0ȑƀ0hJJJJ 0ȑ) 0ȑƀĆLOL,3-'~{vvvvvvvvvvvZTNlb3 `\[TOG@;:3(  T[Fc= YP12 &%& FTYP13 &%& FT ei|ʽ 8襁i}ƅ|L,hƀhhh8hohlhXhhhFffff80)ƅܥ#FfII懥HHL,LGhhhhhƀhh-Ȅʈƅ})H揥>ʈƅ ~擥  抦|ɥ8包~ƅLII懩&&u`hh HHHHHL,}ʈƅFyʈƅ}ʈƍƎƋƊЌإL2d|e~28ʈƅyʈƅƉ` _LWŁ|}ƅLwE||怦}ʚH恺8倅偪ƅ  ILL, _LwLL,E0LL _Lw ILL,ELL _LwEe8刅刪ʈʈݒ&~ƀLV~HHL,~HH~HHHHHHL,~ʈƅFHHHH恥HL,0~}ʈƅ0I愊iʈؚH恥LŁ|} ƅLw ~~8ʭ==` 5l 5 l 5lhzh{hƁhhhƁ}eʆƀƀ|ʊe~8偅z{lzhhhhhh8冐 0 h HHHL,LGIL,h hBCʈ _.ł( Ł|} ŀ}|z Z   :    ( tV8$@hvhwhhxylxh:vwlv8<<+-Í-۲0ݡߑ ع      NER: STRING; 0END; (* RECORD *) & &VAR )BACKGROUND, )ESC, )NULL, )RSPCHR, )RET, )UNDERSCORE +: CHAR; )ESCTYPED +: BOOLEAN; )ERRNUM, )MINDIGITS, )NUMPLACES +: INTEGER; )ALTCHR, )CTRLCHR, )DIGITS, )NORMALCHR, )NULLSET +: CHARSET; )CTRL +: PACKED ARRAY[0..255] OF CTRLTYPE; )DATEDELIM +: STRING[1]; )TODAY +: STRING[6]; )REPORTCTRL +: RPTCTRL; )OUTTEXT +: TEXT; & &PROCEDURE DELAY(DURATION: INTEGER); &PROCEDURE SOUNDBELL; # PROCEDURE GETCHR(NUMDELAYS: INTEGER; WITHBELLS: BOOL63;5š4á53HP 9 K5á2G5á 32 (+-˶5Ä5ء3á5š5 ǀR  jعM5ɡ 5,צ^P5U*fڶšڛ 3 5-Äɡ&5š ^5   [ػ;;ٗ خ8 +; K   ȡؗǀIǀBǀEǀDǀCǀA .Zr  ټ< ߡQ ە݆š ݆  M   ە //k00+- ټ00-/0-á -..///.ټZ ۪P. .   .  ܪP0P0š00ˡٞ 0š?ڹ/)0/0/('0/0 zڪPܹ1/01/0 $צ'221á1021/121*Z pڪP.-ȡ,ŕ > $ ؿ ٿINTEGER;  X x  (  NXxN$ `*ld|Z-W.eW  á  " - 'Type [RETURN] to continue -܂ġ?áۂáȡ^á'Type [RETURN] to continue -1ȡ -háѪP * á6צ'Type [RETURN] when the printer is ready." Ý Ä&"  šEWWUNABLE TO INITIALIZE W.eW  á  " - تP+.P++"P+צ+pP++ZتPٹ,,,,KTT٪PPع".צPRINTER:P.CONSOLE:׀;1;P$;;1;;6 ;P";;6 ; ;1 ;P;;P;,Q;P;;P;Q;3U;P8`d.۪PڪP....@oberת A6Novemberת 06צDecember  ~sh[K=.6צUNKNOWN 66;; 1;; 1. ..1 3;;3;;צ19;3;6;;3;;6;1c44 4 c۪P06;;  6. ... Ȅ.6Januaryת 6Februaryת 6צMarch 6צApril 6צMay 6צJune 6Julyת r6צAugust c6 Septemberת Q6Oct'd P P\|۪P044/ 244/ 344/ 122 Ȅ 2P 211ˏ00330Ȅ..4. 4342 4 7P&67767Q76R7P@  .06-67767Q7P ۝y تPٹ RD٨'d$11š,P111.P )06-677P76Q7Pڝ  ۝77$7Q7PV0%77(7Q7צ)R"6#2%.&*'&)"* 420.,*(&$" 425+h   -,ݪP021 22202  2P ܦתP 11ɡ01327צ+8 O 28+ 88  888K;88(58;r[43 44˄4,FB>!:52&5á52'P5$5(()52*٪P H*H7H7ءצH HHRn+۪P1..BLKLEN] OF CHAR; ) )PCHARBLK += ^CHARBLK; ) )FILEVAR += FILE; # )HDRPARS += PACKED RECORD 0ACTHDR, 0LASTINBLK, 0MAXALLOWED, 0NUMINBLK, 0RECLEN 2: INTEGER; 0BLOCKED, 0STATMAP 2: BOOLEAN; 0DISPLACE 2: 0..BLKLEN; 0END; ) )PHDRPARS += ^HDRPARS; ) )PHDR += RECORD 0CASE INTEGER OF 31: (BUF: PCHARBLK); 32: (PARS: PHDRPARS); 33: (STAT: PSTATBLK); 3END; ) )FILEPARS += RECORD 0HDRPUT, 0RECPUT 2: BOOLEAN; 0CURHDRBLK, 0CURRECBLK, 0CURRECNUM, 0DISPLBITS, 0LASTACTHDR, 0LASTI #USES % APPLESTUFF, &GENUTIL; # #TYPE &SRCHTYPE (= (FIRSTEQ, +FIRSTGE, +NEXTEQ, +NEXTGE); & &PPAGE (= ^PAGE; & &INDIVKEY (= RECORD -RGTSUBTREE: PPAGE; -KEY: STRING[16]; -END; (* RECORD *) , &PAGE (= RECORD -NUMONPAGE: INTEGER; -LFTÕ  ٻáPÄښ?Ä5a Ï ˄  ښ Ä  1 á) Ä   š  áˡ, ˡ  š áء w  4|. á ܚ   šá8  =`  ˡ  š    Õ  ٻáPÄښ?Ä5a Ï ˄  ښ Ä  1 á) Ä   š  áˡ, ˡ ȡ` `  ˡ  š  Ʉń< á  á ܚ   šá8  =`  ˡ  š    ⡞݂ߢ ٚ d š " " ߣ 9`ߣ ߣ ˡ  š ߣ  X  á ȡܚáܡ //-/1-1ȡ.--\ Xڣ ڣ ڣ  š6ޣ áޣ ߢ ޣ ˍ @ šߣ ߣ ˡߣ  šߢ ޚߢ // /  š/ 0//0/0/0/ /ɡ$/   š//0/0/ / ///0 0š}0`//- //0/- / 050á "  .ڣ ڣ ڣ  šڢ,ۣ  š ۣ  š ۢ ؚ< ܣ ˡ  šܢ  :تP"  š FINDNEXT(VAR FVAR: FILEVAR; PFPARS: PFILEPARS; :VAR RECNUM: INTEGER; :STATUS: RECSTATUS); &PROCEDURE CHANGEHDR(VAR FVAR: FILEVAR; PFPARS: PFILEPARS; ;RECNUM: INTEGER; STATUS: RECSTATUS; ;FORCE: BOOLEAN); #IMPLEMENTATION L E UM: INTEGER; 9VAR RECPTR: PCHARBLK); &PROCEDURE PUTREC(VAR FVAR: FILEVAR; PFPARS: PFILEPARS; FORCE: BOOLEAN); &PROCEDURE CLOSEFILE(VAR FVAR: FILEVAR; PFPARS: PFILEPARS); &FUNCTION STATUSOF(VAR FVAR: FILEVAR; PFPARS: PFILEPARS;  and < below.'); /SCREENMSG(0, 16, CLRLINE, CONCAT('>', RESPONSE, 'Maximum response length (RSPLEN)? ', MAXLEN) THEN /EXIT(TESTPROMPT); , ,IF NOALTS(12) THEN /EXIT(TESTPROMPT); , ,STDSCREEN(BANNER); ,REPEAT / /BACKGROUND:= TMPBACKGROUND; /NUMPLACES:= TMPNUMPLACES; /MINDIGITS:= TMPMINDIGITS; / /(* TEST CALL , ,GETCHR(0, FALSE, ['N', 'n', 'L', 'l', 'S', 's', ESC]); ,SCREENMSG(0, 23, CLRLINE, NULLSTRG); ,IF ESCTYPED THEN /EXIT(TESTSCREENMSG); , ,WRITELN(RSPCHR); ,CASE RSPCHR OF /'N', 'n': TMPCMD:= NULLCMD; /'L', 'l': TMPCMD:= CLRLINE; /'S', 's': TMPCMD:= CLRSCREEN; /END; (* CASE *) , ,IF NOSTRG(7, 'What is the MESSAGE? ', TMPSTRG) THEN /EXIT(TESTSCREENMSG); , ,(* TEST CALL *) ,SCREENMSG(MSGX, MSGY, TMPCMD, TMPSTRG); ) ) IF WANTSTOLEAVE THEN /EXIT(TESTSCREENMSG); ) CLEARLCREEN, 5, NULLCMD, '15. Report Control Modules'); )SCREENMSG(MIDSCREEN, 6, NULLCMD, '16. RESPOND'); )SCREENMSG(MIDSCREEN, 7, NULLCMD, '17. SCREENMSG'); )SCREENMSG(MIDSCREEN, 8, NULLCMD, '18. SOUNDBELL'); )SCREENMSG(MIDSCREEN, 9, NULLCMD, '19. STDSCREENMSG(0, 11, NULLCMD, '10. JUSTIFY'); )SCREENMSG(0, 12, NULLCMD, '11. LOCATE'); )SCREENMSG(MIDSCREEN, 2, NULLCMD, '12. LONGDIV'); )SCREENMSG(MIDSCREEN, 3, NULLCMD, '13. MAKESTRG'); )SCREENMSG(MIDSCREEN, 4, NULLCMD, '14. PROMPT'); )SCREENMSG(MIDS)SCREENMSG(0, 5, NULLCMD, '4. EVALINT'); )SCREENMSG(0, 6, NULLCMD, '5. EVALUATE'); )SCREENMSG(0, 7, NULLCMD, '6. FIRSTNON'); )SCREENMSG(0, 8, NULLCMD, '7. FMTDATE'); )SCREENMSG(0, 9, NULLCMD, '8. FMTNUM'); )SCREENMSG(0, 10, NULLCMD, '9. GETCHR'); )S &VAR )MIDSCREEN +: INTEGER; &BEGIN (* DISPMENU *) )MIDSCREEN:= SCRCOLS DIV 2; )SCREENMSG(0, 2, NULLCMD, '1. CHGLEN'); # SCREENMSG(0, 3, NULLCMD, '2. DATECOMPARE'); )SCREENMSG(0, 4, NULLCMD, '3. DELAY'); STRG:= ' not'; ,SCREENMSG(0, 6, CLRLINE, CONCAT(DATESTRG, ' is', TMPSTRG, 8' a valid date.')); ) IF WANTSTOLEAVE THEN /EXIT(TESTVALIDDATE); ) SCREENMSG(0, 6, CLRLINE, NULLSTRG); )UNTIL FALSE; &END; (* OF TESTVALIDDATE *) # #PROCEDURE DISPMENU;E( )'Validates a date string and converts it to packed format.'); )REPEAT ,IF NOSTRG(4, 'Date string (mmddyy) (DATESTRG)? ', DATESTRG) THEN /EXIT(TESTVALIDDATE); , ,(* TEST CALL *) ,IF VALIDDATE(DATESTRG, DATE) THEN /TMPSTRG:= NULLSTRG ,ELSE /TMP.EXIT(TESTSTRGDATE); ( CLEARLINES(5, 7); (UNTIL FALSE; %END; (* OF TESTSTRGDATE *) # #PROCEDURE TESTVALIDDATE; &VAR )DATE +: DATEINT; )DATESTRG, )TMPSTRG +: STRING; &BEGIN (* TESTVALIDDATE *) & STDSCREEN('Testing VALIDDATE'); )DISPPURPOSYEAR:= GETNUM(6, 'What are the last two digits of the YEAR? '); .END; (* WITH *) + +(* TEST CALL *) +STRGDATE(DATE, TMPSTRG); + +SCREENMSG(0, 7, CLRLINE, .CONCAT('The date string (DATESTRG) is ', TMPSTRG)); ( IF WANTSTOLEAVE THEN TNUM *) % %BEGIN (* TESTSTRGDATE *) (STDSCREEN('Testing STRGDATE'); (DISPPURPOSE('Convert a packed date to a string.'); (REPEAT +WITH DATE DO .BEGIN 1DAY:= GETNUM(4, 'What is the DAY number? '); 1MONTH:= GETNUM(5, 'What is the MONTH number? '); 1DATE *: DATEINT; (TMPSTRG *: STRING; % %FUNCTION GETNUM(LINENUM: INTEGER; STRG: STRING) .: INTEGER; (VAR +TMPINT -: INTEGER; (BEGIN (* GETNUM *) +IF NONUM(LINENUM, STRG, TMPINT) THEN .EXIT(TESTSTRGDATE) +ELSE .GETNUM:= TMPINT; (END; (* OF GE+IF NOSTRG(5, 'What is the date (TODAY)? ', TODAY) THEN .EXIT(TESTSTDSCREEN); + +(* TEST CALL *) +STDSCREEN(BANNER); % +IF WANTSTOLEAVE THEN .EXIT(TESTSTDSCREEN); (UNTIL FALSE; %END; (* OF TESTSTDSCREEN *) # #PROCEDURE TESTSTRGDATE; %VAR ( STRING; %BEGIN (* TESTSTDSCREEN *) % STDSCREEN('Testing STDSCREEN'); (SCREENMSG(0, 2, CLRLINE, 'Display a standard screen.'); (REPEAT +IF NOSTRG(4, 'What is the BANNER? ', BANNER) THEN .EXIT(TESTSTDSCREEN); of bells? ', NUMBELLS) THEN /EXIT(TESTSOUNDBELL); ,FOR TMPINT:= 1 TO NUMBELLS DO /BEGIN 2DELAY(300); 2 2(* TEST CALL *) 2SOUNDBELL; / /END; (* FOR *) & UNTIL FALSE; &END; (* OF TESTSOUNDBELL *) # #PROCEDURE TESTSTDSCREEN; %VAR (BANNER *:INES(4, 20); )UNTIL FALSE; &END; (* OF TESTSCREENMSG *) # #PROCEDURE TESTSOUNDBELL; &VAR )NUMBELLS, )TMPINT +: INTEGER; &BEGIN (* TESTSOUNDBELL *) )STDSCREEN('Testing SOUNDBELL...'); )DISPPURPOSE('Sounds a bell.'); )REPEAT ,IF NONUM(4, 'NumberCREEN'); )SCREENMSG(MIDSCREEN, 10, NULLCMD, '20. STRGDATE'); )SCREENMSG(MIDSCREEN, 11, NULLCMD, '21. VALIDDATE'); &END; (* OF DISPMENU *) # #(* $* INSERT REVISIONS YOU WISH TO TEST HERE. $* THEN RE-COMPILE TESTUNIT $*) # #BEGIN (* TESTUNIT *) & &NUMSELS:= 21; &REPEAT )STDSCREEN('Test General Utility Modules'); )DISPMENU; )CASE SELECTION OF ,1: TESTCHGLEN; ,2: TESTDATECOMPARE; ,3: TESTDELAY; ,4: TESTEVINT; ,5: TESTEVALUATE; ,6: TESTFIRSTNON; ,7: TESTFMTDATE; ,8: TESTFMTNUM; ,9: TEASE *) # UNTIL FALSE; #END. (* OF TESTUNIT *) # STGETCHR; ,10: TESTJUSTIFY; ,11: TESTLOCATE; ,12: TESTLONGDIV; ,13: TESTMAKESTRG; ,14: TESTPROMPT; ,15: TESTREPORT; ,16: TESTRESPOND; ,17: TESTSCREENMSG; ,18: TESTSOUNDBELL; ,19: TESTSTDSCREEN; ,20: TESTSTRGDATE; ,21: TESTVALIDDATE; ,END; (* C