`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$J) (jJJ>L+ "?I>  N `  ` x V Nx .x- z `V0^*^*>` aI꽌ɪVɭ&Y&&Y& 꽌ɪ\8`&&꽌ɪɖ'*&%&,E'зЮ꽌ɪФ`+*xH&x'8*7Ixix&&  ') + &п x) ++`FG8`0($ p,&"CPSNK"  SYSTEM.ATTACHvgb  ATTACHUD.CODEvgl7 ATTACH.TEXTvg7APP.TEXT><vg֣AMSP.TEXT><vgM]SR.TEXT><vg]oSC.TEXT><vgorPP.CODE><vg֣ruSP.CODE><vg$PASCALSYSYSATCH uxSR.CODE><vgx{SC.CODE><vg{ PP-SR.CODE<vg PP-SC.CODE<vgעPP.DATA><vgSP.DATA><vgSR.DATA><vgSC.DATA><vg PP-SR.DATA<vg$ע PP-SC.DATA<Gvg$עCLOCKSTUFF.TEXTgCLOCKSTUFF.CODEg CLOCK.TEXT<vgw CLOCK.CODE<vgw CLOCK.LIBRARYvgw START.TEXT=vgWSYSTEM.STARTUPgW DISPLAY.TEXTvg DISPLAY.CODEvg LIST.TEƁ\ƂƁ\ 6U UD137U UD138U UD139U UD140U UD141U UD142U UD143U UDJVM1 /UDRWI :UNDEFU WRITEBIO  PSTAT .XT><vgע LIST.CODE><vgע LISTASM.TEXTvg  LISTASM.CODEvg  LISTER.CODEvgע ACLOCK4.CODEvgWPRINTU PSUBDR =RREAD RINIT REMIU RELOCATE REMOU RWRITE RSTAT 4SYSTU UD128U  UD129U UD130U UD131U UD132U UD133U تPצERROR =>RETURN to exit SYSTEM.ATTACH:R`Y Yآ آ V6000תSצ6000Nآ V4000תSצ6000+V2000תآ Sצ4000 S6000תצNo records in AhhHH`8hhhhhhh h hhȱLC8 ȥ  e ȱ e 8iiHHHH`Jt,40<v^b(-(A needed driver is not in ATTACH.DRIVERSTTACH.DATAȡ Y ATTACH.DATA"ˡ(צ#ATTACH.DATA needed by SYSTEM.ATTACHATTACH.DRIVERS"ˡ+&ATTACH.DRIVERS needed by SYSTEM.ATTACHYˡ1צ,Reading segment dictionary of ATTACH.DRIVERYrc |צ00EE B00EA Gצ00E8 /07L^ȡ  ɡ؞&s&&4Y  Yj8>x8^< |S012345678 9 A B C DEF<Jۨڨš+áġR٪P-././ġh-,,.,04,~ ATTACHUD .,A  IN HEX CHAR--..rZ ڨ铡 VS!4 ٪P,,T تP,,T بġ!4 6SBB  00EE BB00E2 B!00EA Gצ00E8 /0 Y ˡY ˡ  4 YšPá&٪Pצ ERROR => צ#Try again (RETURN to exit program):Rx P@@NPá P@@ ȡإYˡצreading driver,!6 d <ȡةYعQ+~ ( .v4nצY/N:RšצNumber too largeބݛޓWe want a positive numberޡބ<  ݛ7ńۦ תP ݛ0ޡGU /@8Y[<>PJLFHJL579;=?ACEGIKMOQSةY  Y eٓYyؤ ١-(A needed driver is not in ATTACH.DRIVERSP&These next questions will determine if(attached drivers can reside in the hires'pages. It will be assumed they can forצ(page in question if you answer no to theYrc |צ00EE B00EA Gצ00E8 /07L^ȡ  ɡ؞&s&&4Y  Yf8hhhhhhhhצprompt for that page.%Will you ever use the (2000.3FFF hex)צ hires page? /%Will you ever use the (4000.5FFF hex)צ hires page? .Apple pascal attachud [1.1]צEnter name of attach data file:0"ˡlצERROR opening attach data fileצHit RETURN to exit program00g-W-G-7-' {m_QC5?ERROR => Illegal unit number-00-  (Do you want another unit number to referצ%You can't attach a character unit and#a block unit to the same driver. Iצ'will remove the last unit# you entered.00-Type RETURN to continue:to this device driver?:, 0  ^ץ0\ --C%Do you want to attach another driver?-00Xp&L|  B  w-& Do you want this unit to beצinitialized at boot time?00- %Do you want this driver to start on aצcertain byte boundry?L^%The boundry can be between 0 and 256.צ( 0=>Driver can start anywhere.(default)צ% 8=>Driver starts on 8 byte boundry.% N=>Driver starts on N byte boundry.צ,256=>Driver starts on 256 byte PAGE boundry.**šP'Enter boundry (RETURN to exit program):*0 * 0 {  &What is the name of this driver? This'must be the .PROC name in it's assemblyצ source (RETURN to exit program):š Name of driver too long0 +/+/ȡ0++++'Which unit numbers should refer to thisצdevice driver?,0 /0 .00,&Unit number (RETURN to abort program):***z---{- q-@g-ǀ[-ǀO-C-& & 3ATTACH-BIOS document for Apple II Pascal 1.1 $ & & BBy Barry Haynes I CJan 12, 1980 & & & $This document is intended for Apple II Pascal internal applications $writers, Vendors and Users who need to attach their own drivers to the $syst7-+- yskc[QG=3)*ǀǏ*- -@------- -@-w-em or who need more detailed information about the 1.1 BIOS. It is $divided into two sections, one explaining how to use the ATTACH utility $available through technical support and the other giving general $information about the BIOS. It is a good idea to read this whole $document before assuming something is missing or hasn't been completely $explained. This document is intended for more advanced users who $already know a fair amount about I/O devices and how to write device $drivers. It is not rs Eto replace or work with the regular Esystem drivers and also attach drivers Efor devices that will be completely Edefined by you. M M M M $I.RECONFIGURING THE BIOS TO ADD YOUR OWN DRIVERS USING THE ATTACH UTILITY. ( & &INTRODUCTION $intended to be a simple step by step description of $how to write your first device driver, nor does it claim to be a $complete description of all there is to know about the Pascal BIOS. $ &With the Apple Pascal 1.1 System (both regular and runtime 1.1), &there is an automatic method for you to configuer your own drivers &into the system. This method requires you to write the drivers $The Apple Pascal UCSD system has various levels of I/O that are each $responsible for different types of actions. It was divided at UCSD $into these levels to make it easy to bring up the system on various $processors and also various configuration&following certain rules and to use the programs ATTACHUD.CODE and &SYSTEM.ATTACH provided through Apple Technical Support. At boot &time, the initialization part of SYSTEM.PASCAL looks for the program &SYSTEM.ATTACH on the boot drive. If it finds SYs of the same processor and $yet have things look the same to the Pascal level regardless of what $was below that level. The levels are: $ /LEVEL TYPES OF IO ACTIONS /----- ------------------- $ &PascalSTEM.ATTACH, it &Xecutes it before Xecuting SYSTEM.STARTUP. SYSTEM.ATTACH will use &the files ATTACH.DATA and ATTACH.DRIVERS which must also be on the &boot disk. ATTACH.DATA is a file the developer will make using the &program ATTACHUD. It tells SY READ & WRITE EBLOCKREAD & BLOCKWRITE EUNITREAD & UNITWRITE EUNITCLEAR EUNITSTATUS & &RSP (Runtime Support Package) This is part of the interpreter and Eis the middle man between the above Etypes of I/O and the below types STEM.ATTACH the needed information &about the drivers it will be attaching. ATTACH.DRIVERS is a file &containing all the drivers to be attached and is constructed by the &developer using the standard LIBRARY program. The drivers are put on &the Pascaof EI/O. All the above types are Etranslated by the compiler and Eoperating system into UNITREAD, EUNITWRITE, UNITCLEAR and UNITSTATUS if Ethey are not already in that form in Ethe Pascal program. The RSP checks l Heap below the point that a regular program can access it. &They do take away Stack-Heap (= to the size of the drivers attached) &space from that available to Pascal code files but this should not be Ethe legality of the parameters passed Eand reformats these calls into calls to Ethe BIOS routines below. The RSP also Eexpands DLE (blank suppression) Echaracters, adds line feeds to Ecarriage returns, checks for end of Efile (CTRL C from CONSOLE:&a problem unless the drivers are very large or the code files very &hungry in their use of memory. Since these drivers are configured &into the system after the operating system starts to run, this method &will not work for configuring drivers for de), monitors EUNITRW control word commands, makes Ecalls to attached devices if present, Eechoes to the CONSOLE:. M 'BIOS (Basic I/O Subsystem) This is the lowest level device Edriver routines. This is the level Eat which you can attach new drivevices that the system &must cold boot from. Some of supporting code in the RSP, boot and &Bios may make the task of bringing up boot drivers easier though. &The advantages to this kind of setup are: # )1. Software Vendors can use the ATTACHUD program to put ,their own drivers into the system at boot time. This will ,be invisible to the user. ( )2. There can be no problems losing drivers due to improper heap ,management since the drivers are put on the heap by the ,operating system and before ae driver and before any ,programs can be Xecuted. , )6. In case any of your programs use the Hires pages, you can specify ,in ATTACHUD that drivers must not be put on the heap over these ,areas. Your drivers would have to be quite large before they ny user program can allocate heap ,space. , )3. This method does not freeze parts of the system to special ,memory locations since it enforces the clean methodology of ,using relocatable drivers. / & & &USING ATTACHUD & could ,possibly overlap the Hires pages. , &Follow through this example of a session with ATTACHUD where the &options available are completely described. First Xecute ATTACHUD: & &You will be given the prompt: & & *Apple Pascal Attachud [1.1] &ATTACHUD.CODE will ask you questions about the drivers you want to &attach to the system. It makes a file called ATTACH.DATA which tells &SYSTEM.ATTACH which drivers to attach to the system, what unit &numbers to attach them to and other information., *Enter name of attach data file: , &This is asking for what you want the output file from this session &with ATTACHUD to be called. You could call it ATTACH.DATA or some other &name and then rename it to ATTACH.DATA when you put it on the boot dis The options covered &by ATTACHUD are: ( )1. A driver can be attached to one of the system devices, then ,all I/O to this device (PRINTER: for example) will go to ,this new driver. In the case of a new driver for a disk ,device the user will havek &with SYSTEM.ATTACH. ( (If you ever get a message of the form: ( (ERROR => some error (Try again (RETURN to exit program): ( &then just retype what was requested on the previous prompt after &deciding what mistake you made while typing it the f to specify which of the 6 standard ,disk units will go to this new driver. This will allow ,replacement of standard drivers with custom ones without ,having to restrict the I/O interface to UNITREAD and ,UNITWRITE as is the case with option 2. / )irst time. ( &The next prompt is: $ *These next questions will determine if *attached drivers can reside in the hires *pages. It will be assumed they can for the *page in question if you answer no to the *prompt for that page. *Will you ever use 2. A driver can be attached to one of 16 userdevices. I/O to ,these will be done with UNITREAD and UNITWRITE to device ,numbers 128-143. / )3. A method will be included to allow the attached driver to the (2000.3FFF hex) *hires page? $ &Followed by: ( *Will you ever use the (4000.5FFF hex) *hires page? &You should answer yes to the question for a particular Hires page if ,start on an N byte boundry. The driver writer will be ,responsible for aligning his code from that point. & )4. More than one unit can be attached to the same driver. This ,way only one copy of the driver resides in memory and I/O to ,all the at&you will ever be running a program that uses that Hires page while the &drivers are Attached. You don't want the possibility of your driver &residing in the Hires page if that page will be clobbered by one of &your programs. After answering the Hitached units goes to this one driver. It is up to ,the driver to decide which unit's I/O it is doing. How this ,is done is explained below. , )5. The initialize routine for any attached driver can be called by ,SYSTEM.ATTACH after it has attached thres questions you will be asked &the following questions once for each driver you will be attaching: $ *What is the name of this driver? This *must be the .PROC name in its assembly *source (RETURN to exit program):  &This must be the name of one of the drivers in the ATTACH.DRIVERS that &will be used with this ATTACH.DATA. The length of this name must not be &more than 8 characters. After entering the name you will be asked: & Which unit numbers should refer to this *device drn where the first byte of the driver is loaded. If your &driver needs to be aligned on some N byte boundary you can assure it &will be using this mechanism. if you know how the driver's origin is &aligned, You can align internal parts of your driver hiver? * *Unit number (RETURN to abort program):  &You must enter a unit number in the range 1,2,4..12,128..143 or will &be given an error message. You cannot attach a character unit (CONSOLE:, owever you &want. Finally you will get to the prompt: & *Do you want to attach another driver? * &And if you answer Yes to this you will return to the 'What is the name &of this driver' prompt and answering No will end the program, saving &PRINTER: or REMOTE:) to the same driver as a block structured unit and if &you try you will be given the message: & *You can''t attach a character unit and *a block unit to the same driver. I *will remove the last unit# you entered. *Type RETURN t&the data file you have made. 8. 8. 8. 8 && &MAKING ATTACH.DRIVERS $ & 1. Xecute the standard 1.1 LIBRARY program. (2. The output code file should be ATTACH.DRIVERS or could be named +somethine else and renamed ATTACH.DRIVERS when you put it o continue: * &If you don't get the above error, you will be asked:  *Do you want this unit to be *initialized at boot time? ( &A yes response will put the unit number just entered on a list of &units that SYSTEM.ATTACH will call UNITCLEAR on afton the +boot disk. (3. For the Link code file use the code file of your first driver. (4. Copy its slot #1 into slot #0 of ATTACH.DRIVERS. (5. As long as you have more drivers to add, use N(EW to get another +Link code file and copy it's slot #1 into er attaching all &the drivers. This gives you a way to have the system make an initialize &call on your attached unit at boot time. A no response will mean &that no boot time init call will be made on this unit to the driver &you just attached. slots #1,2,...15 of +ATTACH.DRIVERS. (6. When done, type 'Q' then 'N' followed by a RETURN for the notice. +See the 1.1 Operating System Reference Manual for further info on +the LIBRARY program. ( & &THE WORKINGS OF SYSTEM.ATTACH $ (If it is on t( &You will be eventually asked: & *Do you want another unit number to refer *to this device driver?: * &A yes response will get you to the Unit number prompt again and a no &response will get you to the prompt: $ he boot disk, SYSTEM.ATTACH is Xecuted by the operating (system (both regular 1.1 and runtime 1.1) before SYSTEM.STARTUP. The (1.1 runtime system will use a runtime version of SYSTEM.ATTACH. ( *Do you want this driver to start on a *certain byte boundary? * &A yes here will give you more prompts: * *The boundry can be between 0 and 256. * 0=>Driver can start anywhere.(default) * 8=>Driver starts on 8 byte boundary. * N=>Driver starts(The error messages that can be generated by SYSTEM.ATTACH are: * *1. ERROR =>No records in ATTACH.DATA *2. ERROR =>Reading segment dictionary of ATTACH.DRIVERS *3. ERROR =>reading driver *4. ERROR =>A needed driver is not in ATTACH.DRIVERS *5. ERRO on N byte boundary. *256=>Driver starts on 256 byte PAGE boundary. *Enter boundary (RETURN to exit program): & &And the last line of the prompt will repeat until you enter a &boundary in the correct range. The boundary refers to the memory &locatioR =>ATTACH.DATA needed by SYSTEM.ATTACH *6. ERROR =>ATTACH.DRIVERS needed by SYSTEM.ATTACH ( (If all goes well attaching drivers, SYSTEM.ATTACH will display (nothing unusual in the regular boot sequence except for extra disk (accesses and anything done in the init calls to any of the attached (devices. . 8. 8. 8  II.BIOS 3 "This section explains things in the BIOS area that are extensions "and modifications that were added to Apple Pascal version 1.1 that were "differ parameters: > >1. unit#. >2. pointer to a buffer. A(any size buffer you want of type Packed BArray of Char) >3. control word. & 'When you make a Unitstatus call from Pascal, the call should look 'like: & .UNITSTATUS(UNITNUM,PAC,CONTROL); ent or not there at all in Apple Pascal version 1.0 (UCSD version "II.1). > $ $1. The disk routines have been modified to handle interrupts (So 'interrupt driven devices could be attached to 1.1 Pascal) if they are & 'Where UNITNUM & CONTROL are integers and PAC is a Packed Array of 'CHAR or a STRING and may be subscripted to indicate a starting 'position to transfer data to or from. See further information on 'being used. To use interrupts, one would have to attach an 'interrupt driver, then patch the IRQ vector (FFFE hex) to point to 'this driver. The Pascal system is defined to come up with interrupts 'turned off so, once the driver is brought in and th'what Unitstatus is defined to do for the various devices in the 'ATTACH part of this document. ) 'The control word will tell the status procedure for a particular unit 'what information about the unit you want. Bit 0 of this word should 'equal 1 fe IRQ patched, 'interrupts must be turned on. The driver's init call could patch the 'IRQ and turn on interrupts. The disk routines save the current state 'of the system and turn interrupts off only during crucial time 'periods, the state of the systor input status and 0 for output status. Unitstatus is 'implemented with bit 1 of the control word =1 meaning the call is for 'unit control. When this bit =0 the call is for unitstatus. In all 'cases bits 2-12 are reserved for system use and bits 13em is returned during non crucial time 'periods so interrupts can be handled. This has not been tested at 'this time, so there is no data concerning the maximum interrupt response 'time delay. $2. The control word parameter in UNITREAD and UNIT-15 are 'available for user defined funtions. - 'An entry in the jump vector has been made for each of the system 'Unitstatus calls, i.e. CONSOLESTAT,PRINTERSTAT,REMOTESTAT,etc.. 'Unitstatus calls to a user defined device (128-143) will all go 'throWRITE was not passed 'on to the BIOS level routines from the RSP level. This has been done 'in 1.1 to allow the changes to the control word listed below under 'special character checking and also so user defined units or attached ugh the same jump vector location. ( . 8. 8.  * 'Pascal units can use the user defined bits of the control word. ) $3. IORESULTS 128-255 are available for user definition on user defined 'devices. ) $4. UNITSTATUS has been implemented in the Apple II Pascal 1.1 system. 'This works for the Pascal 1 2 hN^ԣ֣system units as described in the ATTACH 'part of this document. For user defined units, Unitstatus can be 'used for whatever necessary. ) 'Unitstatus is a procedure that can be called from the Pascal level in 'the same way Unitread can. It has three ; ERROR, ERROR, EROS (STA ERROR ; CODE = 3 (BNE RET ; ALWAYS, IMMER ;  ; STATUS CODE - ALL WE DO IS PUT A 0 IN THE STATUS  ; RECORD. SOPHISTO, HUH ?  ;  STATUS PLA (STA STREC (PLA (STA STREC+1 ; GET PTR TO STATUS RECORD  ; (PLA ; BY-PASS CTRL WORD (PLA  ; (LDA #0 (TAY (STA @STREC,Y (INY (STA @STREC,Y ; MAKE A 0 WORD (BNE RET ; ALWAYS - WERE DONE  ;  ; OUTPUT CODE - TAKE THE CHAR AND DUMP IT IN THE PORT  ; CHUCK LFS IF LFFLAG IS SET  ;  ; PARALLEL PRINTER DRIVER  ; FOR THE CPS CARD IN PASCAL  ;  ; THIS IS A CRUDE DRIVER FOR ATTACHING TO THE PASCAL SYSTEM  ; USING THE SYSTEM.ATTACH STUFF.  ;  ; UPON INPUT, THE X-REG DEFINES THE TYPE OF CALL:  ; 1 => WRITE CHAR  ; 2 = WRITE LDA LFFLAG (BPL W2 ; BIT 7 CLEAR - SEND LFS (LDA CHAR (CMP #0A ; LF ? (BEQ RET ; YES - NO OUTPUT  ;  W2 JSR GOTOCK ;MANUFACTURE A JSR CONCK  LDA PSTATUS ; PARALLEL CTRL BYTE (AND #POBE > INITIALIZATION  ; 4 => STATUS  ; ANYTHING ELSE IS AN ERROR  ;  ; FOR WRITE CALLS, A-REG HAS THE CHAR  ;  ; (.PROC PARPR  ;  ; PAGE ZILCH VARS (AVAILABLE WITHOUT THE NEED TO SAVE THEM)  ;  RETURN .EQU 0 ; RETURN ADDRESS GOES HER; OUTPUT BUFFER EMPTY ? (BEQ W2 ; NO - KEEP POLLING  ; (LDA CHAR ; WE'RE READY (STA POUT ; PUT IN OUTPUT BUFFER (JMP RET ; AND FINI  ;  ; INIT CODE - STUFF AN I IN THE TYPEAHEAD BUFFER  ;  FRSTFL .BYTE 1 ; FE  STREC .EQU RETURN+2 ; STATUS RECORD POINTER  CHAR .EQU STREC+2 ; TEMPORARY STORAGE FOR OUTPUT CHAR  ERROR .EQU CHAR+1 ; TEMP ERROR CODE STORAGE  ;  ; CPS CARD EQUATES (CARD IN SLOT 1)  ;  PSTATUS .EQU 0C1F9 ; STATUS BYTE ADDRIRST TIME IN FLAG  ;  INIT LDA FRSTFL (BEQ RET ; NOT 1ST TIME, DO 0  ; (LDA #0 (STA FRSTFL ; ONLY DO THIS ONCE (STA RPTR ; RESET READ PTR (LDX #1 (STX WPTR ; SET WRITE ONE PAST (LDA #"I" (STA CBUF,X ; STUFF IN  POUT .EQU 0C1FD ; OUTPUT BUFFER ADDR  POBE .EQU 40 ; BIT 6 = OUTPT BUF EMPTY  ;  ; APPLE PASCAL 'PERMANENT' EQUATES:  ;  CBUF .EQU 3B1 ; TYPE AHEAD BUF ST ADR  RPTR .EQU 0BF18 ; READ PTR: OFST FROM CBUF THAT I 8; FALL THRU TO RET  ;  ; RETURN CODE - PUT RETURN ADDRESS ON STACK, ERROR  ; CODE IN X, AND BEGONE  ;  RET LDA RETURN+1 (PHA (LDA RETURN (PHA (LDX ERROR (RTS (  ;  ; GOTOCK - THIS ROUTINE DOES A JSR CONCK WHICH GETS SPECIAL  WPTR .EQU 0BF19 ; WRITE PTR  LFFLAG .EQU 0BF0F ; LINE FEEDS: BIT 7 => SUPPR  ;  ;  ENTRY STA CHAR ; SAVE OUTPUT CHAR (PLA (STA RETURN ; SAVE RETURN ADR (PLA (STA RETURN+1  ;  ; NOW CHECK X-REG: WHAT KIND OF CALL IS T ; CHARS. AND LOOKAHEAD CHARS. FROM THE CONSOLE  ;  ; PAGE 0 EQUATES  ;  CKADR .EQU 10 ;CONTAINS CONCK ADDR.  AJVAFLD .EQU 0E2 ;PTR. TO ATTACH JUMP VECTOR  ;  ;  ; MISC. EQUATES  ;  CKOFF .EQU 37 ;OFFSET TO CONCK ADDHIS?  ; (LDA #0 (STA ERROR ; PRE-SET ERROR CODE  ; (CPX #2 ; INIT ? (BEQ INIT ; YES  ; (CPX #4 ; STATUS ? (BEQ STATUS ; U-BETCHUMS  ; (CPX #1 ; OUTPUT ? (BEQ WRITE ; AYE-YEA  ; (LDA #3 R. IN BIOSAF  ;  CKR .WORD CKRET-1 ;REQUIRED FOR DOING RET FROM CONCK  ;  ;  GOTOCK LDY #CKOFF ;THE OFFSET (LDA @AJVAFLD,Y ;GET LOW CONCK ADDR. (STA CKADR (INY (LDA @AJVAFLD,Y ;GET HIGH CONCK ADDR. (STA CKADR+1 (LDA CKR+1 (PHA (LDA CKR (PHA ;SET UP RETURN TO CKRTN (JMP @CKADR ;JUMP TO CONCK  CKRET RTS ;RETURN TO CALLER ( (.END (  STREC .EQU RETURN+2 ; STATUS RECORD POINTER  CHAR .EQU STREC+2 ; TEMPORARY STORAGE FOR OUTPUT CHAR  ERROR .EQU CHAR+1 ; TEMP ERROR CODE STORAGE  ;  ; CPS CARD EQUATES (CARD IN SLOT 1)  ;  CMDREG .EQU 0C1FB ; COMMAND REGISTER  STREG .EQU 0C1FB ; STATUS REGISTER (THE DESIRED  DATREG .EQU 0C1FA ; DATA I/O REGISTER  MODEREG .EQU 0C1FA ; MODE REGISTERS  CTLREG .EQU 0C1FE ; CONTROL REG: SWITCHES DBL-BYTES N^ԣ FRAMING .EQU 0C1F3 ; FRAMING PARAMETER IN RAM  BAUDRT .EQU 0C1F2 ; BAUD RATE "  ;  SCRLO .EQU 0 ; SETS SCR BIT LOW  SCRHI .EQU 80 ; SETS SCR HI  STVAL .EQU 0C1 ; VALUE FOR STATUS POLLING  CMDVAL .EQU 23 ; CMD VALUE TO START XMIT  ;  ; APPLE PASCAL 'PERMANENT' EQUATES:  ;  CBUF .EQU 3B1 ; BUFFER ADDR  RPTR .EQU 0BF18 ; READ PTR - 8 BIT OFFSET FROM 3B1  WPTR .EQU 0BF19 ; WRITE PTR  LFFLAG .EQU 0BF0F ; LINE FEEDS: BIT 7 => SUPPR  ;  ;  ENTRY STA CHAR ; SAVE OUTPUT CHAR (PLA (STA RETURN ; SAVE RETURN ADR (PLA (STA RETURN+1  ;  ; NOW CHECK X-REG: WHAT KIND OF CALL IS THIS?  ; (LDA #0 (STA ERROR ; PRE-SET ERROR CODE  ; (CPX #2 ; INIT ? (BEQ INIT ; YES  ; (CPX #4 ; STATUS ? (BEQ STATUS ; U-BETCHUMS  ; (CPX #1 ; OUTPUT ? (BEQ WRITE ; AYE-YEA  ; (LDA #3 ; ERROR, ERROR, EROS (STA ERROR ; CODE = 3  ; SERIAL PRINTER DRIVER  ; FOR THE CPS CARD IN PASCAL  ;  ; THIS IS A CRUDE DRIVER FOR ATTACHING TO THE PASCAL SYSTEM  ; USING THE SYSTEM.ATTACH STUFF.  ;  ; UPON INPUT, THE X-REG DEFINES THE TYPE OF CALL:  ; 1 => WRITE CHAR  ; 2 => (BNE RET ; ALWAYS, IMMER ;  ; STATUS CODE - ALL WE DO IS PUT A 0 IN THE STATUS  ; RECORD. SOPHISTO, HUH ?  ;  STATUS PLA (STA STREC (PLA (STA STREC+1 ; GET PTR TO STATUS RECORD  PLA (PLA ;BYPASS CTRL WORD  ; (LDINITIALIZATION  ; 4 => STATUS  ; ANYTHING ELSE IS AN ERROR  ;  ; FOR WRITE CALLS, A-REG HAS THE CHAR  ;  ; (.PROC SERPR  ;  ; PAGE ZILCH VARS (AVAILABLE WITHOUT THE NEED TO SAVE THEM)  ;  RETURN .EQU 0 ; RETURN ADDRESS GOES HERE A #0 (TAY (STA @STREC,Y (INY (STA @STREC,Y ; MAKE A 0 WORD (BNE RET ; ALWAYS - WERE DONE  ;  ; OUTPUT CODE - TAKE THE CHAR AND DUMP IT IN THE PORT  ; DUMP LFS IF LFFLAG IS SET  ;  WRITE LDA LFFLAG (BPL W2 ; LF FLAG CLR - SEND LFS (LDA CHAR ; NOW CHEK CHAR (CMP #0A ; LF ? (BEQ RET ; YES - NO OUTPUTTIE  ;  W2 JSR GOTOCK ;MANUFACTURE A JSR CONCK  LDA STREG ; POLL STATUS REG (AND #STVAL ; MASK OUT STUPID BITS (CMP #STVR (PHA ;SET UP RETURN TO CKRTN (JMP @CKADR ;JUMP TO CONCK  CKRET RTS ;RETURN TO CALLER ( (.END ( AL ; XMIT BUFFER EMPTY ? (BNE W2 ; NO - KEEP POLLING  ; (LDA CHAR ; WERE READY (STA DATREG ; OUTPUT THAT CHAR  JMP RET ; AND GOOD BYE  ;  ; INIT CODE - SET BAUD RATE & FRAMING  ; THEN ISSUE AN XMIT CMD, AND SELECT DATA REG.  ; FIRST TIME IN, WE RESET TYPEAHEAD BUF, AND STUFF AN I (INIT)  ;  ;  FRSTFL .BYTE 1 ; FIRST TIME IN FLAG  ;  INIT LDA #SCRHI (STA CTLREG ; SET SCR BIT HIGH  ; (LDA CMDREG ; AN^ԣSSURES CORRECT M.R. ORDER (LDA FRAMING (STA MODEREG (LDA BAUDRT (STA MODEREG ; SET BR & F IN MR'S  ; (LDA #CMDVAL (STA CMDREG ; XMIT CMD (LDA #SCRLO (STA CTLREG ; SELECT DATA REG  ;  ; NOW CHECK FOR FIRST TIME IN:  ; (LDA FRSTFL (BEQ RET ; NOT FIRST - DONE  ; (LDA #0 ; IT IS FIRST TIME IN (STA FRSTFL ; CLEAR FLAG FOR NXT TIME (STA RPTR ; RESET READ PTR (LDX #1 (STX WPTR ; SET WPTR 1 OVER (LDA #"I" (STA CBUF,X ; STUFF IN THAT I CMD 8; FALL THRU TO RET  ;  ;  ; RETURN CODE - PUT RETURN ADDRESS ON STACK, ERROR  ; CODE IN X, AND BEGONE  ;  RET LDA RETURN+1 (PHA (LDA RETURN (PHA (LDX ERROR (RTS ;  ; GOTOCK - THIS ROUTINE DOES A JSR CONCK WHICH GETS SPECIAL  ; CHARS. AND LOOKAHEAD CHARS. FROM THE CONSOLE  ;  ; PAGE 0 EQUATES  ;  CKADR .EQU 10 ;CONTAINS CONCK ADDR.  AJVAFLD .EQU 0E2 ;PTR. TO ATTACH JUMP VECTOR  ;  ;  ; MISC. EQUATES  ;  CKOFF .EQU 37 ;OFFSET TO CONCK ADD  ; SERIAL REMOTE DRIVER  ; FOR THE CPS CARD IN PASCAL  ;  ; THIS IS A CRUDE DRIVER FOR ATTACHING TO THE PASCAL SYSTEM  ; USING THE SYSTEM.ATTACH STUFF.  ;  ; UPON INPUT, THE X-REG DEFINES THE TYPE OF CALL:  ; 0 => READ CHAR  ; 1 => WRR. IN BIOSAF  ;  CKR .WORD CKRET-1 ;REQUIRED FOR DOING RET FROM CONCK  ;  ;  GOTOCK LDY #CKOFF ;THE OFFSET (LDA @AJVAFLD,Y ;GET LOW CONCK ADDR. (STA CKADR (INY (LDA @AJVAFLD,Y ;GET HIGH CONCK ADDR. (STA CKADR+1 (LDA CKR+1 (PHA (LDA CKITE CHAR  ; 2 => INITIALIZATION  ; 4 => STATUS  ; ANYTHING ELSE IS AN ERROR  ;  ; FOR WRITE CALLS, A-REG HAS THE CHAR  ; FOR READ CALLS, THE CHAR IS RETURNED IN A-REG  ;  ; (.PROC SERREM  ;  ; PAGE ZILCH VARS (AVAILABLE WITHOUT THE NEED TO SAVE THEM)  ;  RETURN .EQU 0 ; RETURN ADDRESS GOES HERE  STREC .EQU RETURN+2 ; STATUS RECORD POINTER  CHAR .EQU STREC+2 ; TEMPORARY STORAGE FOR OUTPUT CHAR  ERROR .EQU CHAR+1 ; TEMP ERROR CODE STORAGE  ;  ; CPS CARD ; SAVE LOW ORDER CTRL WORD (PLA   ;  ; CHECK DIRECTION (BIT 0 OF CTRL WORD)  ; 0->OUTPUT, 1->INPUT  (TXA ; CTRL WORD (LSR A ; IS IT OUTPUT? (BCC WS ; YES  ; (LDA STREG (AND #RCVST (CMP #RCVST ; CHAR. READEQUATES (CARD IN SLOT 2)  ;  CMDREG .EQU 0C2FB ; COMMAND REGISTER  STREG .EQU 0C2FB ; STATUS REGISTER (THE DESIRED  DATREG .EQU 0C2FA ; DATA I/O REGISTER  MODEREG .EQU 0C2FA ; MODE REGISTERS Y? (BNE WS ; NO  ; (LDA #1 ; A CHAR. IS PRESENT SO 1 IN BUFFER (BNE SETSTAT ; ALWAYS   WS LDA #0 ; SET FOR NO CHAR.  SETSTAT LDY #0 (STA @STREC,Y ; SET LOW STATUS BYTE (TYA (INY  CTLREG .EQU 0C2FE ; CONTROL REG: SWITCHES DBL-BYTES  FRAMING .EQU 0C2F3 ; FRAMING PARAMETER IN RAM  BAUDRT .EQU 0C2F2 ; BAUD RATE "  ;  SCRLO .EQU 0 ; SETS SCR BIT LOW  SCRHI .EQU 80 ; SETS SCR HI  XMITST .E(STA @STREC,Y ; MAKE A 0 WORD (JMP RET ; ALWAYS - WERE DONE  ;  ; OUTPUT ROUTINE: THE SERIAL CMD REG ALWAYS STARTS  ; AND ENDS IN RECEIVE (INPUT) MODE. THE ALGO IS:  ; 1) SET XMIT CMD  ; 2) POLL UNTIL BUFFER EMPTY  ; 3)QU 0C1 ; VALUE FOR WRITE POLLING  RCVST .EQU 0C2 ; VALUE FOR READ POLLING  XMITCMD .EQU 27 ; CMD VALUE TO START XMIT  RCVCMD .EQU 16 ; CMD TO START RECEIVE  ;  ; APPLE PASCAL 'PERMANENT' EQUATES:  ;  CBUF .EQU 3B1 SEND CHAR  ; 4) POLL UNTIL BUF EMPTY  ; 5) SET RCV CMD  ;  WRITE LDA LFFLAG (BPL W2 ; LF FLAG CLR - SEND LFS (LDA CHAR ; NOW CHEK CHAR (CMP #0A ; LF ? (BEQ RET ; YES - NO OUTPUTTIE  ;  W2 LDA #X ; BUFFER ADDR  RPTR .EQU 0BF18 ; READ PTR - 8 BIT OFFSET FROM 3B1  WPTR .EQU 0BF19 ; WRITE PTR  LFFLAG .EQU 0BF0F ; LINE FEEDS: BIT 7 => SUPPR  ;  ;  ENTRY STA CHAR ; SAVE OUTPUT CHAR (PLA (STA RETURN ; SMITCMD (JSR SETCMD ; GIVE XMIT CMD (JSR XWAIT ; WAIT FOR BUF EMPTY  ; (LDA CHAR ; WERE READY (STA DATREG ; OUTPUT THAT CHAR  ; (JSR XWAIT ; WAIT FOR COMPLETION (LDA #RCVCMD (JSR SETCMD ; SET RECEIVE CMD (JMP RET AVE RETURN ADR (PLA (STA RETURN+1  ;  ; NOW CHECK X-REG: WHAT KIND OF CALL IS THIS?  ; (LDA #0 (STA ERROR ; PRE-SET ERROR CODE  ; (CPX #2 ; INIT ? (BEQ INIT ; YES  ; (CPX #4 ; STATUS ? ; END WERE DONE  ;  ; READ ROUTINE: WE ARE ALREADY IN RCV MODE  ; SO ALL WE DO IS GET THE CHAR  ;  READ JSR GOTOCK ;MANUFACTURE JSR CONCK  LDA STREG ; INPUT STATUS (AND #RCVST ; MASK OUT STUPID BITS (BEQ STATUS ; U-BETCHUMS  ; (CPX #1 ; OUTPUT ? (BEQ WRITE ; AYE-YEA  ; (CPX #0 ; INPUT ? (BEQ READ ; UNEQUIVOCALLY SO  ; (LDA #3 ; ERROR, ERROR, EROS (STA ERROR ; CODE = 3 (JMP RET ; ALW(CMP #RCVST ; CHAR READY ? (BNE READ ; NAY  ; (LDA DATREG ; YUP-YUPSKIO (AND #7F ;CLEAR HI-BIT (STA CHAR ; SAVE THAT CHAR (JMP RET ; AND SPLIT  ;  ; INIT CODE - SET BAUD RATE & FRAMING  ; THEN ISSUE AN AYS, IMMER ;  ; STATUS CODE - RETURN 0 FOR WRITE STATUS  ; RETURN 1 FOR READ STATUS IF CHAR. READY  ; 0 OTHERWISE   STATUS PLA (STA STREC (PLA (STA STREC+1 ; GET PTR TO STATUS RECORD (PLA (TAX XMIT CMD, AND SELECT DATA REG.  ; FIRST TIME IN, WE RESET TYPEAHEAD BUF, AND STUFF AN I (INIT)  ;  FRSTFL .BYTE 1 ; FIRST TIME IN FLAG  ;  INIT LDA #SCRHI (STA CTLREG ; SET SCR BIT HIGH  ; (LDA CMDREG ; ASSURES CORRECT M.R. ORDER (LDA FRAMING (STA MODEREG (LDA BAUDRT (STA MODEREG ; SET BR & F IN MR'S  ; (LDA #RCVCMD  JSR SETCMD ; ASSUME RCV MODE  ;  ; NOW CHECK FOR FIRST TIME IN:  ; (LDA FRSTFL (BEQ RET ; NOT FIRST - DONE  ; (LDA #0 ; IT IS FIRST TIME IN (STA FRSTFL ; CLEAR FLAG FOR NXT TIME (STA RPTR ; RESET READ PTR (LDX #1 (STX WPTR ; SET WPTR 1 OVER (LDA #"I" (STA CBUF,X ; STUFF IN THAT I CMD 8; FALL THRU TO RET  ;  ;  ; RETURN CODE - PUT RETURN ADDRESS ON STACK, ERROR  ; CODE IN X, CHAR IN A, AND BEGONE  ;  RET LDA RETURN+1 (PHA (LDA RETURN (PHA (LDX ERROR (LDA CHAR (RTS  ;  ; SUBROUTINE SETCMD - SET A COMMAND INTO THE  ; COMMAND REG, AND RETURN SCR TN^ԣO 0.  ; INPUT: A-REG HAS THE COMMAND  ;  SETCMD LDX #SCRHI (STX CTLREG ; SELECT CMDREG (STA CMDREG ; SET COMMAND (LDX #SCRLO (STX CTLREG ; RESELECT MRS/DR (RTS  ;  ; SUBROUTINE XWAIT: WAIT FOR XMIT READINESS/COMPLETION  ;  XWAIT JSR GOTOCK ;MANUFACTURE JSR CONCK  LDA STREG ; STATUS (AND #XMITST ; READY ? (CMP #XMITST (BNE XWAIT ; KEEP TRYIN (RTS  ;  ; GOTOCK - THIS ROUTINE DOES A JSR CONCK WHICH GETS SPECIAL  ; CHARS. AND LOOKAHEAD CHARS. FROM THE CONSOLE  ;  ; PAGE 0 EQUATES  ;  CKADR .EQU 10 ;CONTAINS CONCK ADDR.  AJVAFLD .EQU 0E2 ;PTR. TO ATTACH JUMP VECTOR  ;  ;  ; MISC. EQUATES  ;  CKOFF .EQU 37 ;OFFSET TO CONCK ADDR. IN BIOSAF  ;  CKR .WORD CKRET-1 ;REQUIRED FOR DOING RET FROM CONCK  ;  ;  GOTOCK LDY #CKOFF ;THE OFFSET (LDA @AJVAFLD,Y ;GET LOW CONCK ADDR. (STA CKADR (INY (LDA @AJVAFLD,Y ;GET HIGH CONCK ADDR. (STA CKADR+1 (LDA CKR+1 (PHA (LDA CKR (PHA  ; SERIAL CONSOLE DRIVER  ; FOR THE CPS CARD IN PASCAL  ;   ; THIS HAS 2 ENTRY POINTS: THE FIRST ONE IS FOR REPLACING  ; THE CONCK ROUTINE (CONSOLE CHECK). THE SECOND IS FOR  ; REGULAR READ, WRITE, INIT, STATUS CALLS.  ;  ; THE CONCK ROUTINE AN ;SET UP RETURN TO CKRTN (JMP @CKADR ;JUMP TO CONCK  CKRET RTS ;RETURN TO CALLER ( (.END ( D THE 4 OTHER ROUTINES ARE ALL MODELLED  ; AFTER THE APPLE PASCAL 1.1 BIOS  ;  ; (.PROC SERCON  ;  ; PAGE ZILCH VARS (AVAILABLE WITHOUT THE NEED TO SAVE THEM)  ;  RETURN .EQU 0 ; RETURN ADDRESS GOES HERE  STREC .EQU RETURN+2 ; STATUS RECORD POINTER  CHAR .EQU STREC+2 ; TEMPORARY STORAGE FOR OUTPUT CHAR  ERROR .EQU CHAR+1 ; TEMP ERROR CODE STORAGE  TEMP .EQU ERROR+1  ;  ; CPS CARD EQUATES (CARD IN SLOT 3)  ;  CMDREG .EQU 0C3FB ; COMMAND REGISTER  STREG .E CODE (STA ERROR (JMP CONRET ; SET ERROR & RTN  ; ;  ;----------------------------------------------  ;  ; STATUS CODE - IF OUTPUT, RETURN A 0. IF INPUT,  ; RETURN THE # OF CHARS IN THE BUFFER  ;  CSTAT PLA  STA STREC (PLA (STAQU 0C3FB ; STATUS REGISTER (THE DESIRED  DATREG .EQU 0C3FA ; DATA I/O REGISTER  MODEREG .EQU 0C3FA ; MODE REGISTERS  CTLREG .EQU 0C3FE ; CONTROL REG: SWITCHES DBL-BYTES  FRAMING .EQU 0C3F3 ; FRAMING PARAMETER IN RAM STREC+1 ; GET PTR TO STATUS RECORD  PLA ;GET CTRL LOB (TAX ;SAVE IT (PLA  ;  ; CHECK THE DIRECTION (BIT 0 OF CTL WORD)  ; 0 => OUTPUT, 1 => INPUT  ;  TXA ;GET BIT 0 OF CTRL WORD  BAUDRT .EQU 0C3F2 ; BAUD RATE "  ;  SCRLO .EQU 0 ; SETS SCR BIT LOW  SCRHI .EQU 80 ; SETS SCR HI  XMITST .EQU 0C1 ; VALUE FOR WRITE POLLING  RCVST .EQU 0C2 ; VALUE FOR READ POLLING  XMITCMD .EQU 27 (LSR A ;OUTPUT? (BCC WS ;YES  ;  ; INPUT STATUS - HOW MANY CHARS IN THE FUBBER?  ; (SEC (LDA WPTR (SBC RPTR (BCS STOSTAT ; A HAS THE # OF CHARS  ; (ADC #CBUFLEN ; RPTR > WPTR, REVERSE DIR (BNE STOSTAT ; ALWAYS  ; ; CMD VALUE TO START XMIT  RCVCMD .EQU 16 ; CMD TO START RECEIVE  ;  ; APPLE PASCAL EQUATES:  ;  SYSCOM .EQU 0F8 ; PTR TO SYSCOM AREA  FLCHR .EQU 53 ; FLUSH CHAR OFFSET FROM SYSCOM  BRKCHR .EQU 54 ; BREAK "  WS LDA #0  STOSTAT LDY #0 (STA (STREC),Y ; STORE LOB (TYA (INY (STA (STREC),Y ; HOB ALWAYS 0 (BNE CONRET ; ALWAYS  ;  ;  ;--------------------------------------------------  ;  ; WRITE ROUTINE: IF THE FLUSH CHAR FLAG IS NOT SET, "  STOPCHR .EQU 55 ; STOP " "  ;  RANDL .EQU 0BF13 ; RANDOM # SEED  RANDH .EQU RANDL+1  CONFLGS .EQU RANDH+1 ; CONSOLE FLAG BYTE  BREAK .EQU CONFLGS+1 ; BREAK VECTOR  RPTR .EQU BREAK+2 ; CONSOLE BUFFER READ PT ; OUTPUT THE CHAR.  ;  CWRITE JSR CNKHDL ; JUST FOR THE HALIBUT (BIT CONFLGS ; FLUSH BIT SET ? (BVS CONRET ; YES - IGNORE CHAR  ;  ; OUTPUT CHAR: THE SERIAL CMD REG ALWAYS STARTS  ; AND ENDS IN RECEIVE (INPUT) MODE. THE ALGO IS:  ;R  WPTR .EQU RPTR+1 ; WRITE PTR  SPCHAR .EQU 0BF1C ; SPEC. FLAG, 0=ALL CHECKING, 2=DON'T CHECK  CONBUF .EQU 3B1 ; CONSOLE BUFFER START  CBUFLEN .EQU 4E  ;  ;---------------------------------------------------  ; 1) SET XMIT CMD  ; 2) POLL UNTIL BUFFER EMPTY  ; 3) SEND CHAR  ; 4) POLL UNTIL BUF EMPTY  ; 5) SET RCV CMD  ;  LDA #XMITCMD (JSR SETCMD ; GIVE XMIT CMD (JSR XWAIT ; WAIT FOR BUF EMPTY  ;  CKENTRY JMP CNKHDL ; CALL CONCK  CNENTRY STA CHAR ; SAVE OUTPUT CHAR  PLA (STA RETURN (PLA (STA RETURN+1  ;  ; NOW CHECK X-REG: WHAT KIND OF CALL IS THIS?  ; (LDA #0 (STA ERROR ; ASSUME SUCCESS ( (CPX #2 ; I(LDA CHAR ; WE'RE READY (STA DATREG ; OUTPUT THAT CHAR  ; (JSR XWAIT ; WAIT FOR COMPLETION (LDA #RCVCMD (JSR SETCMD ; SET RECEIVE CMD  JMP CONRET  ;  ;  ;-----------------------------------------------  ;  ; READ NIT ? (BEQ CINIT ; YES  ; (CPX #4 ; STATUS ? (BEQ CSTAT ; U-BETCHUMS  ; (CPX #1 ; OUTPUT ? (BEQ CWRITE ; AYE-YEA  ; (CPX #0 ; INPUT ? (BEQ CREAD ; UNEQUIVOCALLY SO  ; (LDA #3 ; INVALIDROUTINE - IF THERES A CHAR IN THE FUBBER,  ; RETURN WITH IT. OTHERWISE, LOOP THRU CONCK.  ;  CREAD JSR CNKHDL (LDX RPTR (CPX WPTR (BEQ CREAD ; BUFFER EMPTY - POLL  ; (INX ; BUMP READ PTR (CPX #CBUFLEN ; REMEMBER, ITS CIRCULAR (BNE $5 (LDX #0  ;  $5 STX RPTR (LDA CONBUF,X ; GET CHAR (STA CHAR (JMP CONRET ; AND BEGONE  ;  ;  ;----------------------------------------------  ;  ; INIT ROUTINE - SET SOME POINTERS, FLUSH  ; BUFFER, AND CLEAR THE FLAGS. T ; FLUSH CHAR - TOGGLE FLUSH FLAG  ; ( (TAX (LDA SPCHAR (AND #2 ;CONSOLE SPECIAL CHAR. CHECKING OFF? (BNE NOSPEC ;YES, TIS A PITY (TXA (LDY #STOPCHR (CMP (SYSCOM),Y ; STOP CHAR ? (BNE $2 ; NO (LDA CONFLGS ; HEN SET UP  ; THE CPS CARD: BAUD, FRAMING, ETC.  ;  CINIT PLA (STA SYSCOM (PLA (STA SYSCOM+1 (PLA (STA BREAK (PLA (STA BREAK+1 (LDA RPTR (STA WPTR ; CLEAR BUFFER (LDA CONFLGS (AND #3E (STA CONFLGS ; CLEAR FLUSH + SS  ; YES - TOGGLE STOP BIT (#7) (EOR #80 (STA CONFLGS  JMP DONECK  ;  $2 LDY #BRKCHR ; BREAK ?  CMP (SYSCOM),Y (BNE $3 ; NO (LDA CONFLGS ; YES - CLEAR SS & FLUSH (AND #3F (STA CONFLGS  ; NOW DO CPS CARD INIT:  ;  LDA #SCRHI (STA CTLREG ; SET SCR BIT HIGH  ; (LDA CMDREG ; ASSURES CORRECT M.R. ORDER (LDA FRAMING (STA MODEREG (LDA BAUDRT (STA MODEREG ; SET BR & F IN MR'S  ; (LDA #RCVCMD  JSR SETCM(LDA 0C08B ;FOR FOLDING (JMP @BREAK ; AND ABORT  ;  $3 LDY #FLCHR  CMP (SYSCOM),Y ; FLUSH CHAR ? (BNE REGCHAR ; NO - ITS A REGULAR CHAR (LDA CONFLGS ; YES - TOGGLE FLUSH BIT (#6) (EOR #40 (STA CONFLGS (JMP DONECK D ; ASSUME RCV MODE  ; FALL THRU TO CONRET  ;  ;-----------------------------------------------  ;  CONRET LDA RETURN+1 (PHA (LDA RETURN (PHA (LDX ERROR (LDA CHAR (RTS  ;  ;  ;------------------------------------ NOSPEC TXA ;RESTORE CHAR.  ;  ; ITS A REGULAR CHAR - PUT IT IN THE FUBBER IF THERES ROOM  ;  REGCHAR LDX WPTR (INX (CPX #CBUFLEN (BNE $4 (LDX #0 ; BUMP WRITE PTR  ;  $4 CPX RPTR (BNE BUFOK ; IS THERE ROOM?  ; ----------  ;  ; SUBROUTINE SETCMD - SET A COMMAND INTO THE  ; COMMAND REG, AND RETURN SCR TO 0.  ; INPUT: A-REG HAS THE COMMAND  ;  SETCMD LDX #SCRHI (STX CTLREG ; SELECT CMDREG (STA CMDREG ; SET COMMAND (LDX #SCRLO (STX CTLRE (RING BELL ? ) (JMP DONECK ; NO ROOM - IGNORE CHAR  ;  BUFOK STX WPTR (STA CONBUF,X ; STORE CHAR IN BUF  ;  ; IF STOP CHAR IS SET, THEN KEEP LOOPING  ;  DONECK BIT CONFLGS (BPL CNKEXIT ; NOT SET- RETURN (JMP CLOOP ; ITG ; RESELECT MRS/DR (RTS  ;  ; SUBROUTINE XWAIT: WAIT FOR XMIT READINESS/COMPLETION  ;  XWAIT LDA STREG ; STATUS (AND #XMITST ; READY ? (CMP #XMITST (BNE XWAIT ; KEEP TRYIN (RTS  ;  ;  ; END OF CONSOLE DRIVER DOMAIN  ; S SET - KEEP LOOPING  ;  CNKEXIT PLA (TAY (PLA (TAX (PLA (PLP (RTS  (.END (  ;======================================================  ;  ; START OF CONCK DOMAIN  ;  ;  CNKHDL PHP (PHA (TXA (PHA (TYA (PHA  ;  CLOOP INC RANDL ; BUMP RANDOM SEED (BNE $1 (INC RANDH  ;  ; READ A SERIAL IN CHAR, IF AVAILABLE   PARPR ;  $1 LDA STREG (AND #RCVST (CMP #RCVST (BNE DONECK ; NO CHAR  ; (LDA DATREG ; GET CHAR (AND #7F ; NO BIT 7  ;  ; NOW WE DO OUR SPEC CHAR CHECKING:  ; STOP/START CHAR - TOGGLE SS FLAG  ; BREAK CHAR - ABORT GApple 1.1hh> Ghhhhȑ5 * p)@LeMMIHH`7ȱoHnHl`NA?:$SERPR SERPR  PARPR PARPR  $ SERREM GApple 1.1 SERPR hht2QLhhhhJ )ȑL _'   L ))L­­­© IHH`¢` )`7ȱHHl`GApple 1.1mlg@6*(hh@ ghhhhȑU J )L#OOIHH`7ȱHHl`n_?:$SERREM SERREM   SERCON hh> Ghhhhȑ5 * p)@LeMMIHH`7ȱoHnHl`NA?:$GApple 1.1Lhhv1MLhhhhJ 8iNȑr ,pj'   L NLhhhh)>ííÍíÍé HH`Íâ`)`HHH)])PARPR PARPR  )7U ILUT)?lS I@LUNLU,Lhhh(`eD   gD3'SERCON SERCON  hht2QLhhhhJ )ȑL _'   L ))L­­­© IHH`¢` )`7ȱHHl`mlg@6*($PARPR SERREM SERREM SERREM  GGPARPR SERCON SERCON SERCON  GGhh> Ghhhhȑ5 * p)@LeMMIHH`7ȱoHnHl`NA?:$PARPR @@PARPR PARPR  SERPR @@Lhhv1MLhhhhJ 8iNȑr ,pj'   L NLhhhh)>ííÍíÍé HH`Íâ`)`HHH)])SERREM )7U ILUT)?lS I@LUNLU,Lhhh(`eD   gD3'SERCON PARPR @SERREM  (*------------------------------------------------------*)  (* *)  (* CPS CLOCK INPUT UNIT *)  (* *)  (* MCI *)  (* JUNE, 1981 *)  (* *)  (*------------------------------------------------------*)    (* THIS UNIT PRPARPR @SERCON OVIDES THE INTERFACE TO READ THE CPS #CLOCK FROM A PASCAL PROGRAM. THIS FILE CONTAINS #THE PASCAL PORTION OF THE UNIT, (THE INTERFACE). #THE ACTUAL CLOCK DRIVER CODE IS CONTAINED IN THE #FILE CLOCKREAD. *) # #  (*$S+*) #  UNIT CLOCKSTUFF; INTRINSIC CODE 23 DATA 24;   (* THE CODE AND SEGMENT NUMBER SELECTION IS #ARBITRARY AND MAY BE CHANGED BY THE USER. *) # #  INTERFACE   TYPE TIMEREC = RECORD ( (DAYOFWEEK : (MONDAY,TUESDAY,WEDNESDAY,THURSDAY, N^g5FRIDAY,SATURDAY,SUNDAY); 5 (DATE : RECORD ( MONTH : 0..12; ( DAY : 0..31; ( YEAR : 0..99 ( END; ( (TIME : RECORD ( HOUR : 0..23; ( MINUTE, ( SECOND : 0..59 ( END / & END; (  VAR  "SYSTIME : TIMEREC; "CLOCK : BOOLEAN; " "  PROCEDURE TIMESTAMP(VAR TS : TIMEREC);    IMPLEMENTATION   CONST NOCLOCK = 200;   VAR CS,  XDAY, (XMON, (XDATE, (XYEAR, (XHOUR, (XMIN, (XSEC : INTEGER; (  FUNCTION CLOCKSLOT: INTEGER; EXTERNAL;   PROCEDURE GTIME; EXTERNAL;    PROCEDURE TIMESTAMP;   BEGIN   GTIME;  CASE XDAY OF !0: TS.DAYOFWEEK:= SUNDAY; !1: TS.DAYOFWEEK:= MONDAY; !2: TS.DAYOFWEEK:= TUESDAY; !3: TS.DAYOFWEEK:= WEDNESDAY; !4: TS.DAYOFWEEK:= T   TYPE TIMEREC = RECORD ( (DAYOFWEEK : (MONDAY,TUESDAY,WEDNESDAY,THURSDAY, x-r-r)brPINTEGER bREAL hCHAR "rBOOLEAN .xSTRING TEXT xHURSDAY;  5: TS.DAYOFWEEK:= FRIDAY; !6: TS.DAYOFWEEK:= SATURDAY  END;  TS.DATE.MONTH := XMON;  TS.DATE.DAY := XDATE;  TS.DATE.YEAR := XYEAR;  TS.TIME.HOUR := XHOUR;  TS.TIME.MINUTE := XMIN;  TS.TIME.SECOND := XSEC;   END; (* OF GETTIME *) INTERACT8INPUT dOUTPUT RNKEYBOARDFALSE LxTRUE ~bxdNIL MAXINT Db      BEGIN   CS:= CLOCKSLOT; "IF CS=NOCLOCK THEN CLOCK:= FALSE ELSE CLOCK:= TRUE; "TIMESTAMP(SYSTIME) "  END. (* OF IMPLEMENTATION *)    READ hREADLN WRITE ZWRITELN EOF EOLN 6PRED >SUCC ORD  SQR  ABS j NEW  UNITREADp UNITWRITCONCAT LENGTH INSERT DELETE COPY POS 5FRIDAY,SATURDAY,SUNDAY); 5 (DATE : RECORD ( MONTH : 0..12; ( DAY : 0..31; ( YEAR : 0..99 ( END; ( (TIME : RECORD ( HOUR : 0..23; ( MINUTE, ( SECOND : 0..59 ( END / & END; (  VAR  "SYSTIME : TIMEREC; "CLOCK : BOOLEAN; " "  PROCEDURE TIMESTAMP(VAR TS : TIMEREC);    IMPLEMENTATION E CONCAT LENGTH INSERT DELETE COPY POS  CLOCKSTUCLOCKSTU #4/*% +(%"آ آ آ cآ آ ;آ ;á(2E, ( SECOND : 0..59 ( END / & END; (  VAR  BBB"SYSTIME : TIMEREC; "CLOCK : BOOLEAN; " "  PROCEDURE TIMESTAMP(VAR TS : TIMEREC);    IMPLEMENTATION E CONCAT LENGTH INSERT DELETE COPY POS CLOCK CLOCKSLO CS GTIME SYSTIME XDAY XDATE  XMON XHOUR  XMIN  XYEAR  XSEC  D : 0..59 ( END / & END; (  VAR  BYTE, 2-DIGIT BCD # STORED AT P1  ; AND PACKS IT INTO A 2-BYTE BINARY # STORED  ; AT P2. WE KNOW THE RESULT IS ALWAYS < 255  ; SO THE HOB IS ALWAYS SET TO 0.  ; (.MACRO XFER (LDA %1+1 (ASL A ; = TENS DIG"SYSTIME : TIMEREC; "CLOCK : BOOLEAN; " "  PROCEDURE TIMESTAMP(VAR TS : TIMEREC);    IMPLEMENTATION E CONCAT LENGTH INSERT DELETE COPY POS IT * 2 (STA TEMP (ASL A (ASL A ; = TENS DIG * 8 (ADC TEMP ; = TENS DIG * 10 (ADC %1 ; + ONES DIGIT (STA %2 ; = THE NUMBER (.ENDM  (.MACRO POP (PLA (STA %1 (PLA (STA %1+1 (.ENDM ( (.MACRO FPOP (POP %1 N^w(PLA (PLA (PLA (PLA (.ENDM ( (.MACRO PUSH (LDA %1+1 (PHA (LDA %1 (PHA (.ENDM ( (.MACRO RETURN (PUSH %1 (RTS (.ENDM (  ;  ;  ; GLOBAL PARMS FOR OUTPUT: ( (.PUBLIC XDAY,XMON,XDATE,XYEAR,XHOUR,XMIN,XSEC,CS (   ;  ; PAGE ZERO:  ;  RTADR .EQU 0 ; RETURN ADDRESS  CN00 .EQU 2 ; PTR TO CN00, N=SLOT  TEMP .EQU 4 ; SCRATCH  ;  ; CPS CARD EQUATES:  ;  CLKIO .EQU 0F9 ; OFFSET FOR CLOCK I/O REG  CLKCTL .EQU 0FE ; OFFSET FOR CONTROL REG  HOLD .EQU 040 ; HOLD BIT  HOLDRD .EQU 050 ; HOLD + READ BIT  ;  ; SLOT FINDER ADDRESSES/SIGNATURES:  ;  NOCLOCK .EQU 0C8  ADR1 .EQU 0EA  SIG1 .EQU 8  ADR2 .EQU 0EC  SIG2 .EQU 4  ADR3 .EQU 0EE  SIG3 .EQU 2  ; (.NOPATCHLIST  ; .NOPESTSTRIP   ;  ; CLOCKSLOT - SEARCHES FOR CPS CLOCK SLOT.  ; RETURNS CN, N=1,7 IF FOUND  ; C8, IF NOT FOUND  ;  .FUNC CLOCKSLOT ( (FPOP RTADR (LDA #0 (STA CN00 (LDA #0C1  ; -----------------------------------------------------;  ;  ;  ; CPS PASCAL SOFTWARE - CLOCK INPUT ROUTINE  ;  ; BY PDD & GP , 6/81  ;  ; THERE ARE TWO PROGS: CPSCLOCK, A SLOT FINDER AND  ; GTIME, A CLOCK READER.  ;  ; THE 1ST PROG FINDS THE (STA CN00+1 ; = C100   CHECK1 LDY #ADR1 (LDA (CN00),Y (CMP #SIG1 ; BYTE 1 MATCH ? (BNE NEXT ; NEGATORY ONE-NINER  (LDY #ADR2 (LDA (CN00),Y (CMP #SIG2 ; BYTE 2 ? (BNE NEXT ; NAY ( (LDY #ADR3 (LDA (CN00),Y (CMCPS CARD SLOT.  ;  ; THE 2ND PROGRAM READS THE TIME FROM THE CPS CLOCK.  ; IT IS THE GUTS OF THE CPSCLOCK UNIT SUPPLIED ON  ; THE PASCAL DISKETTE.  ;  ;  ;  ; ------------------------------------------------------  ;  ;  ; MACRO XFER: TAKES A 2-P #SIG3 ; 3RD BYTE TOO ? (BEQ THRU ; YOU BET - WE HAVE A SLOT   ; NOT THIS SLOT, TRY THE NEXT ONE   NEXT INC CN00+1 ; = CN+1 (LDA CN00+1 (CMP #NOCLOCK ; SLOT 8 YET ? (BNE CHECK1 ; NO - DO ANOTHER (  THRU LDA #0 (PHA (LDA CN00+1 ;THE CN SLOT # (PHA (RETURN RTADR   ;  ; GTIME - READ THE TIME STRING FROM CPS TO XVARS  ; IF CS=$C8 THEN SET TIME = 0 0/0/00 00:00:00  ;  (.PROC GTIME ( (POP RTADR  ;  ; INITIALIZE VARIABLES  ;  LDA #0 (S ; THE GLOBAL OUTPUT PARAMETERS.  (XFER SECO,XSEC ( (XFER MIN,XMIN ( (XFER HOUR,XHOUR ( (XFER DATE,XDATE ( (XFER MON,XMON ( (XFER YEAR,XYEAR ( (LDA DAY (STA XDAY   RET RETURN RTADR ( (.END  TA XMON (STA XMON+1 (STA XDATE (STA XDATE+1 (STA XYEAR (STA XYEAR+1 (STA XDAY (STA XDAY+1 (STA XHOUR (STA XHOUR+1 (STA XMIN (STA XMIN+1 (STA XSEC (STA XSEC+1  STA CN00   LDA CS (CMP #NOCLOCK ;DOES CLOCK EXIST? (BNE DOREAD ;YES (JMP RET ;NO CLOCK, SO LONG CHARLIE (  ;  ; THE BOARD EXISTS SO READ THE TIME INTO  ; A BUFFER. HERES THE BUFFER:   SECO .BYTE 0,0  MIN .BYTE 0,0  HOUR .BYTE 0,0  DAY .BYTE 0  DATE .BYTE 0,0  MON .BYTE 0, CLOCKSLO 0  YEAR .BYTE 0,0   TBUF .EQU SECO ; BUFFER PTR    ; FIRST, SET THE HOLD BIT:   DOREAD STA CN00+1 ;SET THE CN VALUE  LDX #0 ; OUR ADDR COUNTER (LDA #HOLD (LDY #CLKCTL (STA (CN00),Y ; SET HOLD (  ; NOWGApple 1.1 DELAY 150 USEC  (LDY #1E  $1 DEY (BNE $1 (  ; SET READ AND ADDR BITS (AND KEEP HOLD SET)   RLOOP LDY #CLKCTL (TXA ; = ADDR (ORA #HOLDRD ; + HOLD + READ  STA (CN00),Y   ; DELAY 6 USEC  (LDA (CN00,X) ; BOhhhhhhHHHH`HhhL@ P))>@ ٠?  em>A  em@C  emBGUS (  ; READ THE DIGIT, AND MASK OUT SPECIAL BITS IN  ; TENS HOUR AND TENS DAYS  (LDY #CLKIO (LDA (CN00),Y ; = THE DIGIT + CRAP (AND #0F ; = THE DIGIT ( (CPX #5 (BEQ MASKIT ; SPEC CASE 1 (CPX #8 F  emEH  emGJ  emIDHH`rjf^ZRNFB:6.*     wi[WFN(BNE NOMASK ; REGULAR DIGIT (  MASKIT AND #3 ; WANT ONLY 2 BITS   NOMASK STA TBUF,X ; STORE THE FINAL DIGIT    ; NOW CLEAR THE READ BIT, BUT KEEP HOLD SET  (LDY #CLKCTL (LDA #HOLD (STA (CN00),Y (  ; ARE WE DONE YET ? XMIN XHOUR XDAY CS XMON XDATE XSEC XYEAR CLOCKSLO CLOCKSLOXMIN vs XHOUR pm XDAY 7jg  (INX (CPX #13. ; 13 DIGITS ? (BNE RLOOP ; NO (  ; WERE DONE, NOW CLEAR HOLD  (LDY #CLKCTL (LDA #0 (STA (CN00),Y ( ;  ; ---------------------------------------------  ;   ; THE TIME HAS BEEN READ IN. NOW WE TRANSFER THEM TO CS  XMON !XU GTIME GTIME XDATE ^[ XSEC |y XYEAR 1da    R %T LONGINTIPASCALIOCHAINSTUTRANSCENTURTLEGRTURTLEGRAPPLESTUCLOCKSTUCLOCKSTU  "~HHHHHHL,~ʈƅFHHHH恥HL,0~}ʈƅ0I愊iʈؚH恥LŁ|} ƅL\ ~~8ʈƅ  ILlL, DG BB'"GGBL\LlL,E0LL DL\ ILlL,ELL DL\Ee8刅刪ʈʈww&~ʈƅFyʈƅ $ "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}ʈƍƎƋƊЌإLl2d|e~28ʈƅyʈƅƉ` DL?Ł|}ƅL\E||怦}ʚH恺8倅偪ʈƅ})H揥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 M.SWAPDISK&:(7,צ*SYSTEM.WRK.CODE[*]To what codefil>ʈƅ ~~擥 ~ 抦|ɥ8包~ƅLlII懩&&u`hh HHHHHL,} ei|ʽ 8襁i} &  * عteVG8  )  T uh[NA4'á +-Íƅ|L,hƀhhh8hohlhXhhhFffff80)ƅܥ#FfII懥HHL,L5hhhhhƀhh-ȑhhƀ 0ȑƀ0hJJJJ 0ȑ) 0ȑƀĆL-۲z0ݡߑ ع      y :L,VSNNNNNNNNNNNYO MIHA<4-('  AH3P|v:n Y   9    ' sU7z ;|hvhwhhxylxMz|vwlvl llhzh{hƁhh ' "PROCEDURE FSEEK(VAR F: FIB; RECNUM: INTEGER); PROCEDURE FREADREAL(VAR F: FIB; VAR X: REAL); "PROCEDURE FWRITEREAL(VAR F: FIB; X: REAL; W, D: INTEGER);   IMPLEMENTATION $ "PROCEDURE FSEEK(*VAR F: FIB; RECNUM: INTEGER*); $LABEL 1; $VAR BYTE,BhƁ}eʆƀƀ|ʊe~8偅z{lzhhhhhh8冐 0 h HHHL,L5IL,h h'(ʈ D.ł( Ł|} ŀ}|ƀL;~HHL,~HHLOCK,N: INTEGER; "BEGIN SYSCOM^.IORSLT := INOERROR; $IF F.FISOPEN THEN &WITH F,FHEADER DO (BEGIN BLOCK := 0; BYTE := FBLKSIZE; *IF (RECNUM < 0) OR NOT FSOFTBUF OR 2((DFKIND = TEXTFILE) AND (FRECSIZE = 1)) THEN ,GOTO 1; (*NO SEEK ALLOWED*) *IF FRECSIZE < FBLKSIZE THEN ,BEGIN N := FBLKSIZE DIV FRECSIZE; .WHILE RECNUM-N >= 0 DO 0BEGIN RECNUM := RECNUM-N; 2BYTE := BYTE+N*FRECSIZE; 2WHILE BYTE > FBLKSIZE DO 4BEGIN BLOCK := BLOCK+1; 6BYTE := BYTE-FBLKSIZE 4END 0END ,END; *WHILE RECNUM > 0 DO , "PROCEDURE SETCHAIN(TYTLE:STRING); "PROCEDURE SETCVAL(VAL:STRING); "PROCEDURE GETCVAL(VAR VAL:STRING); "PROCEDURE SWAPON; "PROCEDURE SWAPOFF; "  IMPLEMENTATION E :::&:(xáצAssembleצCompile what tBEGIN RECNUM := RECNUM-1; .BYTE := BYTE+FRECSIZE; .WHILE BYTE > FBLKSIZE DO ' "PROCEDURE FSEEK(VAR F: FIB; RECNUM: INTEGER); PROCEDURE FREADREAL(VAR F: FIB; VAR X: REAL); "PROCEDURE FWRITEREAL(VAR F: FIB; X: REAL; W, D: INTEGER); ext? ( ׯ,á(+( "ˡ$ Can't find ::9 ƀ:ײ9 ƀ:צSYSTEM.SWAPDISK&:(7,צ*SYSTEM.WRK.CODE[*]To what codݢݣޢÄɡ3ڕġ$ڕšš"šޣ Ąޣ ݣ ˡRݣ &ݢ ݢݢ!ݣ "ˡݣ ˄ݢ!ۂتPš++0تPRš&+R+P&P0&Ršز&RPز&PR,VV"6h ssembleצCompile what t"ˡ\ݣ ݣ šݢ ݣ ݢݣݣ ݣ ݣݣńݢݣݢݢݢˡݢݢ ۚݢܚ  / |á +-Í-ڲzؼ 0ext? ( ׯ,á(+( "ˡ$ Can't find ::9 ƀ:ײ9 ƀ:צSYSTEM.SWAPDISK&:(7,צ*SYSTEM.WRK.CODE[*]To what cod.áBڲzؼ0ݞ$ڲzjeEÍɍEáޢ >ۓɡ ؼ݀$ ؼݞ$ۡܡ ؼ$ Dɍ -    "FUNCTION SIN(X:REAL):REAL; "FUNCTION COS(X:REAL):REAL; "FUNCTION EXP(X:REAL):REAL; "FUNCTION ATAN(X:REAL):REAL; "FUNCTION LN(X:REAL):REAL; "FUNCTION LOG(X:REAL):REAL; "FUNCTION SQRT(X:REAL):REAL;   IMPLEMENTATION E BBBLNz)$ $ ݞ$' ݑ$ $݂ō $݂ġ ݂$ $ $ȡ%  0 ފ$čV   .ˡ:  E ŽDnP42D<.CODECEND.CODECODEPDISKҎԎ,nr r nrnʤr INT^n6 6 \^^\n6 r <INTP3XTTɡ  -ݑ š 0 0 ߿`ġ(   ݂. ݕ ؂݂3  ݕ 0 . ݑ0 ݕ݂ ؂ ɡ  |, R -   tI$'>ߡڑ߳RI@߳}:#9oLE.6Z"O$<=*     4?$ $ ݞ$' ݑ$ $݂ō $݂ġ ݂$ $ $ȡ%  0 ފ$čV   .ˡ:  E  ??;ܳ1?ܳ^; Sƀ> ?L=[?    ??  ġ+@ነ? ?> ??   '~~5?. ??Sǯ?Ǭ?ǰ?Ǯ?ǩ?áǫ?Ǭ?r2 ٢ؚڢؚڢٚ ۚܢښܢٚܢؚɡšܢɡܢǿšܢǿɡܢɡܢ??2 ?  ??  1?   ?=~@:?^>[' ~ ~l   ڪP."ˡ[̄$ʄ$N.ʄ$M ń.ʄ$M  ʄ$̄$.ʄ$M .ʄ$M Y@ ) >?  ȡ!2? 5? f   '~~5?. ??6تP+,+,ȡ+++V 0 Z Zʎ^ Z) ><0??2 ?  ??  1?   ?=~@:?^>[' ~ ~ ZN1>н Z)C>oc ZET> Zf>Y Z(w>g ZP>탽 Z(>K  ZL>ȱ ZT>z7 ZU>ٰ ZO>? Z(>| ZC>}̽ ZE>  $TYPE $ SCREENCOLOR=(none,white,black,reverse,radar, 3black1,green,violet,white1,black2,orange,blue,white2); $ $PROCEDURE INITTURTLE; $PROCEDURE TURN(ANGLE: INTEGER); $PROCEDURE TURNTO(ANGLE: INTEGER); $PROCEDURE MOVE(DIST: INTEGER); $PROCEDURE ZG>? ZT>ca Z >*r Z;>aq ZL>^ ZN>9 Z ? ZO?ٽ Z ?ƨ !Z; ?vm "ZB?F' #ZR?ս $ZP?y %ZX? &Z MOVETO(X,Y: INTEGER); $PROCEDURE PENCOLOR(PENMODE: SCREENCOLOR); $PROCEDURE TEXTMODE; $PROCEDURE GRAFMODE; $PROCEDURE FILLSCREEN(FILLCOLOR: SCREENCOLOR); $PROCEDURE VIEWPORT(LEFT,RIGHT,BOTTOM,TOP: INTEGER); $FUNCTION TURTLEX: INTEGER; $FUNCTION TD? 'ZO!? (ZC$? )Z '?| *Z)+?+L +ZR.?l ,ZR1?ս -ZA5?D .Z8?& /Z;?: 0Z>?> 1ZA?4 2Z.D?v 3Z.F? URTLEY: INTEGER; $FUNCTION TURTLEANG: INTEGER; $FUNCTION SCREENBIT(X,Y: INTEGER): BOOLEAN; $PROCEDURE DRAWBLOCK(VAR SOURCE; ROWSIZE,XSKIP,YSKIP,WIDTH,HEIGHT, 8XSCREEN,YSCREEN,MODE: INTEGER); $PROCEDURE WCHAR(CH: CHAR); $PROCEDURE WSTRING(S: STRING) 4ZI? 5ZTL?Xs 6ZUO? 7Z)Q? 8ZNT?; 9Z)V?% :ZEY? ;Z[?Lo <Z(]?г =ZP_? >Z(b? ?ZLd?  @ZTf?] AZUh?; $PROCEDURE CHARTYPE(MODE: INTEGER); $ "IMPLEMENTATION E $PROCEDURE TEXTMODE; $PROCEDURE GRAFMODE; $PROCEDURE FILLSCREEN(FILLCOLOR: SCREENCOLOR); $PROCEDURE VIEWPORT(LEFT,RIGHT,BOTTOM,TOP: INTEGER); $FUNCTION TURTLEX: INTEGER; $FUNCTION T BZOi?޽ CZ(k?7 DZCm?[ EZEn? FZGp? GZTr?  HZ s?yx IZ;t?hн JZLv?D KZNw?F LZ x?Re MZOy?Pp NZ z?g OZ;{?K PZB|?a QZR|?ٽ RZP}?4 SZX~? TZD~? UZO? VZC?[` WZ ?& XZ)?ؽ YZR?  ZZR?2 ZZá.ٹ# &    0&!"   #"  ` ` `SN-(' . hhhhhhHH `  HH8H8  hhhL .+ rhh heheؑؑ!ٹا ZZا Zا Zا ZZfا ZZا Z:ا Zا ZZb8 ؂ɡheheHHL<  B  ""##8&$iT8&UU !  U"# UT`+%$Y)!p v hhhhhhhhhhH8 )%HHH`5>hhh)hh h h h hhhhhh h2ɡhh h.آآآǿآآǿآآD ٚ SYSTEM.CHARhhhhhhhhHH v # " `' & 8 ! 0"ee8 !  e e8"#0 88$ % 0"ee8$ %  e e8&'0 8SETáSYSTEM.CHARSET  @! @4` - G`` 8`*UH)JJh & & f)4#ie*e+)*)fjfjfj+*fjfjfj8 8) )` (J(F ((Lee Lw  )Lb I1Lb )QLb        xhX JL` T$Q%P)Q I L`#JI`'  I` I0ݩ(0/,",i8i#Hiihifi`i,i,3iPII4ifH8H hIiH h hL8OF=2. F | R T DL X,j X & Z,DX p,vp,DY vBKGND PEEKSTRO,ADDRESS ,vDIRSRCIif E J j 8  e e  `(J 8 e  ` Z Z< $ %$PQ $  ߩ $ Li`t^H v-DRIVE $-P-v$-FNAM D.SETSINE1`--SETSINE2SETDEFAU-SETPORT -P -2(MAKEPOcY}zeNEDh0h1hhhhh.h/h,h-h*h+h(h)(ȱ(*ȱ*,ȱ,.ȱ. HH1H0H(ȹ(*ȹ*,ȹ,.ȹ.`   ""##   $ $FUNCTION PADDLE(SELECT: INTEGER): INTEGER; $FUNCTION BUTTON(SELECT: INTEGER): BOOLEAN; $PROCEDURE TTLOUT(SELECT: INTEGER; DATA: BOOLEAN); $FUNCTION KEYPRESS: BOOLEAN; $FUNCTION RANDOM: INTEGER; $PROCEDURE RANDOMIZE; $PROCEDURE NOTE(PITCH,DURATI)`%)8`)    L)ˢ   â LE % %  )  `8`&e epɀj f f&e e pɀjff %) % )`% L=`0(%$ $ @'ON: INTEGER); $ "IMPLEMENTATION E .CODESKSWAPDISKҎԎ,nr r nrnʤr LIT^n6 6 \^^\n6 r DLITURAS Phhhhhhh)hpdHHHH`4hhhhhhhi)hH`HHH`0hhhJhh)*XhHH`"hhhhhhH! \L HHH`<hhhhhhHHLM05FRIDAY,SATURDAY,SUNDAY); 5 (DATE : RECORD ( MONTH : 0..12; ( DAY : 0..31; ( YEAR : 0..99 ( END; ( (TIME : RECORD ( HOUR : 0..23; ( MINUTE, ( SECOND : 0..59 ( END / & END; (  VAR  `L+L10`LELK뭕 JF8ȹe8ИL`Lø{{ttmnghab\\WWRRMNIIEEAA=>::673401..+,))&'$%"# !"SYSTIME : TIMEREC; "CLOCK : BOOLEAN; " "  PROCEDURE TIMESTAMP(VAR TS : TIMEREC);    IMPLEMENTATION E CONCAT LENGTH INSERT DELETE COPY POS $hhhhhh9.:.;.<0(0(099JH;HHH`Z310/$ T?@AB ?UB`2<(^#4/*% +(%"آ آ آ cآ آ ;آ ;á(hhhhhhHHHH`HhhL@ P))>@ ٠?  em>A  em@C  emBF  emEH  emGJ  emIDHH`rjf   TYPE TIMEREC = RECORD ( (DAYOFWEEK : (MONDAY,TUESDAY,WEDNESDAY,THURSDAY, x-r-r)brPINTEGER bREAL hCHAR "rBOOLEAN .xSTRING TEXT x^ZRNFB:6.*     wi[WFNREADLN WRITE ZWRITELN EOF EOLN 6PRED >SUCC ORD INTERACT8INPUT dOUTPUT RNKEYBOARDFALSE LxTRUE ~bxdNIL MAXINT Db    SQR  ABS j NEW  UNITREADp UNITWRITCONCAT LENGTH INSERT DELETE COPY POS   READ hREADLN WRITE ZWRITELN EOF EOLN 6PRED >SUCC ORD N VAR NOW E X ERR A  O^#W SQR  ABS j NEW  UNITREADp UNITWRITCONCAT LENGTH INSERT DELETE COPY POS  VAR AMPM: STRING;  BEGIN #WITH DIRECTORY DO BEGIN &PAGE (OUTPUT); &GOTOXY (0,7); &WRITELN ('Welcome ', DISK.DISKNAME, ', to Apple II Pascal 1.1'); &WRITELN; &WRITELN ('Based on UCSD Pascal II.1'); &WRITELN; &WRITE ('Current date is '); &IF CLOCK THEN )CASE SYSTIME.DAYOFWEEK OF ,SUNDAY: WRITE ('Sunday '); ,MONDAY: WRITE ('Monday '); ,TUESDAY: WRITE ('Tuesday '); ,WEDNESDAY: WRITE ('Wednesday '); ,THURSDAY: WRITE ('Thursday ');  PROGRAM SYSTEMDATE; (* "SYSTEM.STARTUP" PROGRAM - SETS THE SYSTEM DATE *) 8(* JGH - 1981, MODIFIED JLC - 1981 *)  (* GAP - 1981 *)  USES CLOCKSTUFF;   TYPE DATE = PACKED RECORD /MONTH: 0..12; /DAY: 0..31; /YE,FRIDAY: WRITE ('Friday '); ,SATURDAY: WRITE ('Saturday '); )END; (* CASE *) &CASE DISK.DISKDATE.MONTH OF )1: WRITE ('January '); )2: WRITE ('February '); )3: WRITE ('March '); )4: WRITE ('April '); )5: WRITE ('May 'AR: 0..100; ,END; % %(* THIS DIRECTORY INFO HAS BEEN PUBLISHED IN THE "CIDER PRESS" *) %(* PUBLISHED BY THE SAN FRANCISCO APPLE CORPS *) % %DISKINFO = RECORD 3A: ARRAY [0..2] OF INTEGER; 3DISKNAME: STRING [7]; 3B: ); )6: WRITE ('June '); )7: WRITE ('July '); )8: WRITE ('August '); )9: WRITE ('September '); (10: WRITE ('October '); (11: WRITE ('November '); (12: WRITE ('December '); &END; (* CASE *) &WRITELN (DISK.DISKDATE.DAY, ' INTEGER; 3FILES: INTEGER; 3C: INTEGER; 3DISKDATE: DATE; 3D: INTEGER; 3E: INTEGER; 0END; % %FILEINFO = RECORD 3STARTING: INTEGER; 3ENDING: INTEGER; 3FILETYPE: 0..7; 3FILENAME: STRING, 19', DISK.DISKDATE.YEAR); &WRITELN; &IF CLOCK THEN BEGIN 'WITH SYSTIME.TIME DO BEGIN )WRITE ('Current time is '); )AMPM := 'AM'; (* ADJUST FOR 12 HOUR TIME *) )IF HOUR > 11 THEN BEGIN ,HOUR := HOUR - 12; ,AMPM := 'PM'; )END [15]; 3WHOCARES: INTEGER; 3FILEDATE: DATE; 0END;   VAR YEAR, LOBYTE, HIBYTE: INTEGER; $DIRECTORY: RECORD 3DISK: DISKINFO; 3FILES: ARRAY [1..77] OF FILEINFO; 0END; # ; )IF HOUR = 0 THEN HOUR := 12; )WRITE (HOUR, ':'); )IF MINUTE < 10 THEN WRITE ('0'); )WRITELN (MINUTE, ' ', AMPM); & END; (* WITH *) &END &ELSE WRITELN ('No CPS Card in the system.'); &GOTOXY (0,19);  PROCEDURE UPDATE; (* READ THE CLOCK AND UPDATE "ROOT VOLUME" *)  BEGIN #WITH DIRECTORY DO BEGIN &UNITREAD (4, DIRECTORY, SIZEOF (DIRECTORY), 2); &IF CLOCK THEN BEGIN )TIMESTAMP(SYSTIME); )DISK.DISKDATE.MONTH := SYSTIME.DATE.MONTH; )DISK.DISKDAT&WRITELN ('(c) Apple Computer Inc. 1979, 1980'); &WRITELN ('(c) U. C. Regents 1979'); #END; (* WITH *)  END;  BEGIN (* MAIN *) #UPDATE; #PRINTIT;  END (* PROGRAM *).  E.DAY := SYSTIME.DATE.DAY; )DISK.DISKDATE.YEAR := SYSTIME.DATE.YEAR; )UNITWRITE (4, DIRECTORY, SIZEOF (DIRECTORY), 2); # END; (* IF *) #END; (* WITH *)  END; (* UPDATE *)   PROCEDURE PRINTIT; (* DISPLAY THE NEW BOOT-TIME WELCOME SCREEN *) c) Apple Computer Inc. 1979, 1980צ(c) U. C. Regents 1979zR"$*Rber 6 December  s]I4 , 19 צCurrent time is AMתP š צPMPá  : ɡ 0  .צNo CPS Card in the system.#(SYSTEMDA N VAR NOW E X ERR O^#B2  dJ צWelcome  , to Apple II Pascal 1.1Based on UCSD Pascal II.1צCurrent date is צSunday צMonday צ Tuesday t Wednesday [צ Thursday CצFriday -צ Saturday jS=)צJanuary צ February March April May June צJuly August {צ September cצOctober Mצ November 6 December  s]I4 , 19  PROGRAM DISPLAY;   (* THIS PROGRAM PRINTS OUT THE CURRENT  TIME ON THE SCREEN. *)   USES APPLESTUFF,CLOCKSTUFF;   VAR CH: CHAR;  SEC,MIN,HR,MINPOS: INTEGER;   PROCEDURE PRINTTITLE;  BEGIN #PAGE(OUTPUT); #GOTOXY(10,8); #WRITELN(' צCurrent time is AMתP š צPMPá  : ɡ 0  .צNo CPS Card in the system.#(DISPLAY OF THE TIME'); #GOTOXY(9,9); #WRITELN('(Hit any key to exit)')  END;   PROCEDURE NEWHOUR; (* DISPLAY THE NEW LEADIN STRING *)  VAR I: INTEGER; $STAMP,S,AMPM: STRING;  BEGIN #GOTOXY(0,12); FOR I:=1 TO 40 DO WRITE(' '); #WITH SYSTIME DO BEGIN # CASE DAYOFWEEK OF ,SUNDAY: STAMP:= 'Sunday '; ,MONDAY: STAMP:= 'Monday '; ,TUESDAY: STAMP:= 'Tuesday '; ,WEDNESDAY: STAMP:= 'Wednesday '; ,THURSDAY: STAMP:= 'Thursday '; ,FRIDAY: STAMP:= 'Friday '; & SATURDAYEC:= SYSTIME.TIME.SECOND; #REPEAT UPDATE UNTIL KEYPRESS;  READ(KEYBOARD,CH)  END.  : STAMP:= 'Saturday '; &END; (* CASE *) &CASE DATE.MONTH OF )1: STAMP:= CONCAT (STAMP, 'January '); )2: STAMP:= CONCAT (STAMP, 'February '); )3: STAMP:= CONCAT (STAMP, 'March '); )4: STAMP:= CONCAT (STAMP, 'April '); )5: STAMP:= CONCAT (STAMP, 'May '); )6: STAMP:= CONCAT (STAMP, 'June '); )7: STAMP:= CONCAT (STAMP, 'July '); )8: STAMP:= CONCAT (STAMP, 'August '); )9: STAMP:= CONCAT (STAMP, 'September '); (10: STAMP:= CONCAT (STAMP, 'Octobe`DISPLAY r '); (11: STAMP:= CONCAT (STAMP, 'November '); (12: STAMP:= CONCAT (STAMP, 'December ') &END; (* CASE *) &STR(DATE.DAY,S); STAMP:= CONCAT (STAMP, S, ', 19'); &STR(DATE.YEAR,S); STAMP:= CONCAT (STAMP, S, ' '); &M := 'AM'; (* ADJUST BA*FOR 12 HOUR TIME *) &HR:= TIME.HOUR; &IF TIME.HOUR > 11 THEN BEGIN & TIME.HOUR := TIME.HOUR - 12; )AMPM := 'PM' &END; &IF TIME.HOUR = 0 THEN TIME.HOUR := 12; &STR(TIME.HOUR,S); STAMP:= CONCAT (STAMP,S, ':'); &MINPOS:= (32 - LENGTH(STAMP)) DIV 2;   צDISPLAY OF THE TIME צ(Hit any key to exit)l (}}ȡ xTSunday תP}TMonday תPmTTuesday תP\Tצ Wednesday PIT Thursday תP7TFriday תP'T&GOTOXY(0,12); &FOR I:= 1 TO MINPOS DO WRITE(' '); &WRITE(STAMP,' ',AMPM); # MINPOS:= MINPOS + LENGTH(STAMP) #END (* WITH *)  END;  PROCEDURE UPDATE; (* UPDATE SECONDS *)  BEGIN #WITH SYSTIME.TIME DO BEGIN Saturday תPoaRA1#T}}TP}צJanuary X}PT}}TP}צ February Y}PT}}TP}March V}PT}}TP}April V}PT}}TP}May T}PT}}TP}June U}PT}}T&REPEAT TIMESTAMP(SYSTIME) UNTIL SEC<>SECOND; &IF HR<>HOUR THEN NEWHOUR; &IF MIN<>MINUTE THEN BEGIN )MIN:= MINUTE; )GOTOXY(MINPOS,12); )IF MINUTE < 10 THEN WRITE('0'); )WRITE(MINUTE,':') &END &ELSE GOTOXY(MINPOS+3,12); &SEC := SECOND; &IF SEC < P}צJuly U}PT}}TP}August W}PT}}TP}צ September Z}PT}}TP}צOctober X}PiT}}TP}צ November Y}PDT}}TP} December Y}P hH( eB+P T10 THEN WRITE('0'); &WRITE(SEC) #END; (* WITH *) #GOTOXY(30,9)  END; (* UPDATE *)   BEGIN (* MAIN *) #PRINTTITLE; #IF CLOCK=FALSE THEN BEGIN %GOTOXY(0,12); %WRITELN('No CPS Card in the machine.'); %EXIT(PROGRAM); #END; #HR := -1; MIN:= -1; S}}TP}+Ǡ}, 19Ǥ}P+P T}}TP}+Ǡ} ǡ}PAMתP š PMתPá +P T}}TP}+Ǡ}:ǡ}P T }}ȡ T TJ:[ˡˡˡ3  ɡ 0 :  ɡ 0  |v8 צNo CPS Card in the machine.N A LINE *) "LINECOUNT: INTEGER; "FILENAME: STRING; (* TEXT FILE TO READ *) "TITLENAME: STRING; (* NAME USED IN TITLE LINE *) "INFILE,OUTFILE: TEXT;  TITLELINE: STRING[255]; (* 1ST HEADER LINE *) "TIMELINE: STRING[255]; (* 2ND 3 &"MתP š PMתPá +P T}}TP}+Ǡ}:ǡ}P T }}ȡ THEADER LINE *) "SEPARATORLINE: STRING[255]; (* 3RD HEADER LINE *)  LINE: STRING[255]; "PAGENUMBER: INTEGER; "PAGELIMIT: INTEGER; (* DETERMINES # OF CHARS. IN PAGE NUM. *)   FUNCTION SETPARMS: BOOLEAN; EXTERNAL;   PROCEDURE SETIO; N^ע VAR I: INTEGER;  BEGIN "I:= LENGTH(FILENAME); "WHILE (I>0) AND (COPY(FILENAME,I,1) <> '.') DO I:= I-1; "IF I=0 THEN BEGIN $TITLENAME:= FILENAME; $FILENAME:= CONCAT(FILENAME,'.TEXT'); "END "ELSE TITLENAME:= COPY(FILENAME,1,I-1); "I:= POS(':',TITLENAME); "IF I>0 THEN DELETE(TITLENAME,1,I); "RESET(INFILE,FILENAME); "REWRITE(OUTFILE,'PRINTER:');  END; (* SETIO *)   PROCEDURE SETTITLELINE; (* CREATES THE 1ST HEADER LINE *)  VAR I,J: INTEGER;  BEGIN "TITLELINE:= TITLENAME;  IF PAGING THEN BEGIN $J:= (LINELENGTH-LENGTH(TITLELINE)-6); $FOR I:= 1 TO J DO &TITLELINE:= CONCAT(TITLELINE,' '); $TITLELINE:= CONCAT(TITLELINE,'PAGE 1') "END "ELSE BEGIN $J:= (LINELENGTH-LENGTH(TITLELINE)) DIV 2; $FOR I:= 1 TO J DO &TITLELINE:= CONCAT(' ',TITLELINE); "END;  END; (* SETTITLELINE *)   PROCEDURE SETTIMELINE; (* CREATES THE 2ND HEADER LINE *)  VAR I,J: INTEGER; $S,AMPM: STRING;  BEGIN #TIMESTAMP(SYSTIME); #WITH SYSTIME DO BEGIN # CASE DAYOFWEEK OF ,SUNDAY: TIMELINE:= 'Sunday '; PROGRAM OUTTEXT;   (* THIS PROGRAM WILL OUTPUT A TEXT FILE TO THE PRINTER. AT THE TOP "OF EACH PAGE OF THE OUTPUT WILL BE THE PROGRAM NAME, PAGE # AND "THE DATE & TIME IF PAGING WAS SELECTED AS A CPS DEVICE PARAMETER. *) "  USES CLOCKSTUFF;   VA,MONDAY: TIMELINE:= 'Monday '; ,TUESDAY: TIMELINE:= 'Tuesday '; ,WEDNESDAY: TIMELINE:= 'Wednesday '; ,THURSDAY: TIMELINE:= 'Thursday '; ,FRIDAY: TIMELINE:= 'Friday '; & SATURDAY: TIMELINE:= 'Saturday '; &END; (* CASE *) &CR "PAGING: BOOLEAN; (* TRUE IF PAGING WAS SELECTED *) "LINESPERPAGE: INTEGER; (* NUMBER OF PRINTABLE LINES ON A PAGE *) "LINESTOSKIP: INTEGER; (* NUMBER OF LINES TO SKIP OVER PERFORATIONS *) "LINELENGTH: INTEGER; (* MAX. NUMBER OF CHARACTERS IASE DATE.MONTH OF )1: TIMELINE:= CONCAT (TIMELINE, 'January '); )2: TIMELINE:= CONCAT (TIMELINE, 'February '); )3: TIMELINE:= CONCAT (TIMELINE, 'March '); )4: TIMELINE:= CONCAT (TIMELINE, 'April '); )5: TIMELINE:= CONCAT (TIMELINE, 'May '); )6: TIMELINE:= CONCAT (TIMELINE, 'June '); )7: TIMELINE:= CONCAT (TIMELINE, 'July '); )8: TIMELINE:= CONCAT (TIMELINE, 'August '); )9: TIMELINE:= CONCAT (TIMELINE, 'September '); (10: TIMELINE:= CONCAT (TIMELINE, 'October,S); "DELETE(TITLELINE,POS('PAGE ',TITLELINE)+5,LENGTH(S)); "TITLELINE:= CONCAT(TITLELINE,S); "OUTHEADER;  END; (* NEXTPAGE *)   BEGIN (* MAIN PROG *) "PAGE(OUTPUT); "GOTOXY(0,10); "IF CLOCK=FALSE THEN BEGIN $WRITELN('No CPS Card in the machine. '); (11: TIMELINE:= CONCAT (TIMELINE, 'November '); (12: TIMELINE:= CONCAT (TIMELINE, 'December ') &END; (* CASE *) &STR(DATE.DAY,S); TIMELINE:= CONCAT (TIMELINE, S, ', 19'); &STR(DATE.YEAR,S); TIMELINE:= CONCAT (TIMELINE, S, ' '); '); $EXIT(PROGRAM); "END; "WRITE('ENTER FILE NAME - '); "READLN(FILENAME); "IF FILENAME='' THEN EXIT(PROGRAM); "IF SETPARMS=FALSE THEN BEGIN $GOTOXY(0,14); $WRITELN('Printer is not associated with the CPS Card.'); " EXIT(PROGRAM); "END; &M := 'AM'; (* ADJUST FOR 12 HOUR TIME *) &IF TIME.HOUR > 11 THEN BEGIN & TIME.HOUR := TIME.HOUR - 12; )AMPM := 'PM' &END; &IF TIME.HOUR = 0 THEN TIME.HOUR := 12; &STR(TIME.HOUR,S); TIMELINE:= CONCAT (TIMELINE,S, ':'); # IF TIME.MINUTE"SETIO; "SETHEADER; "PAGE(OUTPUT); OUTHEADER;  PAGENUMBER:= 1; PAGELIMIT:= 10; "WHILE EOF(INFILE)=FALSE DO BEGIN $READLN(INFILE,LINE); $WRITELN(LINE); WRITELN(OUTFILE,LINE); $LINECOUNT:= LINECOUNT+1; $IF PAGING AND (LINECOUNT >= LINESPERPAGE) TH < 10 THEN TIMELINE := CONCAT(TIMELINE,'0'); &STR(TIME.MINUTE,S); TIMELINE := CONCAT(TIMELINE,S,' ',AMPM); &J:= (LINELENGTH - LENGTH(TIMELINE)) DIV 2; &FOR I := 1 TO J DO )TIMELINE := CONCAT(' ',TIMELINE) #END; (* WITH *)  END; (* SETTIMELINE *)  EN NEXTPAGE; "END; (* WHILE *) "CLOSE(INFILE);  PAGE(OUTPUT);  END. (* MAIN PROG *)   PROCEDURE SETSEPARATOR; (* SETS 3RD HEADER LINE *)  VAR I: INTEGER;  BEGIN "SEPARATORLINE:= '-'; "FOR I:=2 TO LINELENGTH DO $SEPARATORLINE:= CONCAT(SEPARATORLINE,'-');  END; (* SETSEPARATOR *)   PROCEDURE OUTHEADER; (* OUTPUT THE HEADER *)  BEGIN  WRITELN(TITLELINE); WRITELN(OUTFILE,TITLELINE); "WRITELN(TIMELINE); WRITELN(OUTFILE,TIMELINE); "WRITELN(SEPARATORLINE); WRITELN(OUTFILE,SEPARATORLINE); "WRITELN; WRITELN(OUTFILE); "LINECOUNT:= 4;  END; (* OUTHEADER *)   PROCEDURE SETHEADER;  BEGIN "SETTITLELINE; "SETTIMELINE; "SETSEPARATOR;  END; (* SETHEADER *)   PROCEDURE NEXTPAGE;  (* SKIP OVER THE PERFORATIONS AND OUTPUT NEXT HEADER *)  VAR I: INTEGER; $S: STRING;  BEGIN "PAGENUMBER:= PAGENUMBER+1; "FO" OUTTEXT R I:=1 TO LINESTOSKIP DO BEGIN $WRITELN; WRITELN(OUTFILE); "END; "IF PAGENUMBER=PAGELIMIT THEN BEGIN $DELETE(TITLELINE,LENGTH(TITLENAME)+1,1); (* REMOVE A BLANK *) $TITLELINE:= CONCAT(TITLELINE,' '); $PAGELIMIT:= PAGELIMIT*10; "END; "STR(PAGENUMBERBA*ť.á'1PP.TEXTUP1Pצ:1š1ZPRINTER:X 1fȡ( ƞI,Printer is not associated with the CPS Card.  L44Z4ZĄ  Z PAGE 1<ȡ&צ - 4צSunday 4Monday תs4צTuesday a4צ Wednesday M4צ Thursday :4Friday ת)4צ Saturday vgWE4%f 0xhv ++++T Z  3צNo CPS Card in the machine.ENTER FILE NAME - Pׯ4UU4UצJanuary U4UU4Uצ February U4UU4UMarch U4UU4UApril U4UU4UMay U4UU4UJune U4UMONDAY FRIDAY FILENAMELINESPERLINELENGLINECOUNINFILE LINE 4LINESTOSOUTFILE ZTUESDAY THURSDAYSATURDAYPAGING PAGENUMBPAGELIMIU4UצJuly U4UU4UAugust U4UU4Uצ September U4UU4UצOctober Uu4UU4Uצ November UJ4UU4U December U SUNDAY SEPARATOSETPARMS TIMELINE4TITLENAM1TITLELINWEDNESDA o  3צNo CPS Card in the machine.ENTER FILE NAME - Pׯ~X4qH,P 4UU4U,U, 19U,P 4UU4U,U UAMתP š צPMPá ,P 4UU4U,Uצ:U ɡ!4N^UU4Uצ0U,P 4UU4U,U UU4UUȡ&4VVצ V4V.J-ȡ(צ-0 DZZ4Z4ZZZZ++ȡZá61+++ + P צPAGE ++++T Z  3צNo CPS Card in the machine.ENTER FILE NAME - Pׯ  ;  ; SETPARMS - THIS FUNCTION SETS THE VARIABLES PAGING,LINESPERPAGE,  ; LINESTOSKIP, & LINELENGTH. THE VALUES ARE DETERMINED FROM THE  ; BATTERY BACKED RAM OF THE CPS CARD FOR THE DEVICE IN SLOT #1.  ;  ; RETURNS VALUE TRUE IF THERE IS A CPS C(LDA #1 ;SET FOR PAGING TRUE  GOOD STA PAGING  (LDX #0 (STX RAMSEL ;SWITCH TO BANK 0 ( (LDA #1  NOGOOD TAX (LDA #0 (PHA ;HI BYTE OF RETURN VALUE (TXA (PHA ;LO BYTE OF RETURN VALUE (LDA RTADR+1 (PHA ARD ASSOCIATED TO SLOT 1.  ; (.FUNC SETPARMS  .PUBLIC LINELENGTH,PAGING,LINESPERPAGE,LINESTOSKIP   ; PAGE ZERO   RTADR .EQU 0 ; RETURN ADDRESS   ; CPS CARD EQUATES   DEVBYT .EQU 0C1F4 ; ADDRESS OF DEFAULT OUTPUT DEV(LDA RTADR (PHA ;THE RETURN ADDRESS (RTS  (.END  ICE  CPSSLOT .EQU 0C1F0 ; ADDRESS OF CPS SLOT #, CN  SELBYT .EQU 0C1F7 ; ADDRESS OF SLOTS SELECTED  SELDEV .EQU 0C1F6 ; ADDRESS OF SELECTED SLOT DEVICES  RAMSEL .EQU 0C1F8 ; ADDRESS FOR RAM BANK SWITCHING  LENBYT .EQU 0C1F2 ; ADDRESS OF LINE LENGTH  PAGEBYT .EQU 0C1F3 ; ADDRESS OF PAGING & LINESPERPAGE  SKIPBYT .EQU 0C1F5 ; ADDRESS OF LINESTOSKIP  PARRAM .EQU 20 ; PARALLEL BANK SELECT VALUE  SERRAM .EQU 10 ; SERIAL BANK SELECT VALUE  DEFDEV .EQU 8 ; MASK FOR DEFAULT OUTPUT DEVICE  SLOT1 .EQU 2 ; MASK FOR SLOT 1 SELECTED  (PLA (STA RTADR (PLA (STA RTADR+1 ; SAVE RETURN ADDRESS (PLA (PLA (PLA (PLA ; FUNCTION STUFF ( (LDX #PARRAM ; A SETPARMS SSUME PARALLEL (LDA CPSSLOT (CMP #0C1 ; IS CPS BOARD IN SLOT 1? (BNE SELECT ; NO ( (LDA DEVBYT (AND #DEFDEV ;IS IT PARALLEL? (BNE ISPAR ;YES (BEQ ISSER ;NO (  SELECT LDA SELBYT  AND #SLOT1 ;DEVICE SELECTGApple 1.1ED IN SLOT 1? (BEQ NOGOOD ;NO ( (LDA SELDEV  AND #SLOT1 ;IS IT PARALLEL? (BNE ISPAR ;YES (  ISSER LDX #SERRAM ;SET FOR SERIAL  ISPAR STX RAMSEL ;MAKE BANK SWITCH  (LDA #0 (STA LINELENGTH+1 (STA PAGING+1 (Shhhhhh )):) HHHH`>=<;71-*TA LINESPERPAGE+1 (STA LINESTOSKIP+1 ( (LDA LENBYT ;GET LINE LENGTH (STA LINELENGTH (LDA PAGEBYT ;DOING PAGING? (BEQ GOOD ;NO ( (STA LINESPERPAGE (LDA SKIPBYT ;GET LINES TO SKIP (STA LINESTOSKIP LINELENGA2LENGLINESTOSO;STOSSETPARMS SETPARMSLINESPERI8SPERPAGING T5NG  ~X4qH,P 4UU4U,U, 19U,P 4UU4U,U UAMתP š צPMPá ,P 4UU4U,Uצ:U ɡ!4UU4Uצ0U,P 4UU4U,U UU4UUȡ&4VVצ V4V.J-ȡ(צ-0 D OUTTEXT ZZ4Z4ZZZZ++ȡZá61+++ + GAP צPAGE ++++T Z  3צNo CPS Card in the machine.ENTER FILE NAME - Pׯť.á'1PP.TEXTUP1Pצ:1š1ZPRINTER:X 1fȡ( ƞI,Printer is not associated with the CPS Card.  L44Z4ZĄ  Z PAGE 1<ȡ&צ - 4צSunday 4Monday תs4צTuesday a4צ Wednesday M4צ Thursday :4Friday ת)4צ Saturday vgWE4%f 0hhhhhh )):) HHHH`>=<;71-*:> e machine.ENTER FILE NAME - Pׯ4UU4UצJanuary U4UU4Uצ February U4UU4UMarch U4UU4UApril U4UU4UMay U4UU4UJune U4U"ANALOGCL U4UצJuly U4UU4UAugust U4UU4Uצ September U4UU4UצOctober Uu4UU4Uצ November UJ4UU4U December U BA*NjȡNnjڂ`قǴZZZUhǹZǴǾȡU_ :[Sun.תPdצMon.PWTue.תPJצWed.P=Thr.תP0צFri.P#Sat.תPVK@5*o |צJan.P|Feb.תP|צMar.P|Apr.תP|צMayPz|צJunePm|JulyתP`|צAug.PS|Sep.תPF|צOct.P9|Nov.תP,|צDec.P vlaVK@5*̀ƀPƀצ Qƀ|ǡƀצ ǢƀPSP ̀ƀPƀSǠƀצ, 19ǤƀP*P ̀ƀPƀ*ǠƀPá̀ƀPƀ QƀP K}A}AKKX)bAS+a