IMD 1.17: 14/03/2012 8:33:22 RS232: B3466A 3.5" DS      RS232  MYVME.PAST__K .@-VME.ASMT__K:b@a#BUB_DVRT__Kk@"j!BUBBLEST__K@$EPROMST___K @& F9885T____K(%@($PRINTERT__KM+@1*AMIGOT____Kx@7CS80T_____KƓ@DŠRST_______KG@WFRS_DRVT___K9A8MAKE_232T_KGGCOMDCLT___KN AGPIODVRT__Kn6A5,DRVASMT___K A DISCHPIBT_KGAFREADMET___ COMP20 2 FREADMET___K D (*Name 'VME.DRIVER.TEXT' by Rolf Eisenhut BCD R&D 26.Nov.1985 Revised by Pedro Alonzo BCD R&D 17.Mar.1986 *) $LINES 2000000,modcal,debug off,heap_dispose$ (*changed pau 17.03.86*) $search 'VME.ASM' { ,'IOLIB:KERNEL' {'*INTERFACE.','*IO.'}$  MODULE VME_DRIVER ; IMPORT VME_ASM_DRIVER (* from Assembly VME.ASM *), IODECLARATIONS (* from 'IO' *), isr, sysglobals ; EXPORT TYPE Mode_type = (ByteInc,WordInc,ByteFxd,WordFxd); (*changed pau 17.03.86*) Short_int = SHORT ; VME_Addr = INTEGER ; Addr_mod_type = 0..63 ; TYPE User_Proc = procedure(Status_Id,IntLevel : Integer ); Procedure VME_BlockRead (Sc : TYPE_ISC ; VAR Data : ANYPTR ; NumOfBytes : INTEGER ; Transfer_mode : Mode_type; Addr_mod : Addr_mod_type; Source : VME_Addr); P      : TYPE_ISC); PROCEDURE VME_RESET (Sc : TYPE_ISC); procedure VME_Enable_Intr (Sc : TYPE_ISC ; UserProc : User_proc ); procedure VME_Disable_Intr(Sc : TYPE_ISC ); IMPLE if isc_table[sc].card_id<>VmeCardId then escape(WrongVmeId); Timeout(isc_table[sc].io_tmp_ptr^.timeout); TRANSFER_IN(SC,SOURCE,DATA,NumOfBytes,Addr_mod,ord(Transfer_mode)); (*changed pau 17.03.86*) end else if NumOfBytes<0 theMENT const VmeCardId = 17 ; IntReg3 = 3 ; IntOccured= 64 ; Intenable = 128 ; RangeErr = 800; (*added pau 17.03.86*) OddSelectCode = 801; (*added pau 17.03.86*) NumOfCharErr = 803; OddNn escape(NumOfCharErr); end; (* VME_BlockRead *) Procedure VME_BlockWrite; begin if (Sc < 8) then escape(RangeErr); (*add pau 17.03.86*) if odd (Sc) then escape(OddSelectCode); (*add pau 17.03.86*) if NumOfBytes>0 trocedure VME_BlockWrite(Sc : TYPE_ISC ; VAR Data : ANYPTR ; NumOfBytes : INTEGER ; Transfer_mode : Mode_type; Addr_mod umOfBytes = 805; WrongVmeId = 806; type Vme_isr = record intlvl : ^User_proc; isribvar: pisrib ; end; VmeIntTable = array[8..30] of Vme_isr; var VMEISRTABLE: VmeIntTable;  : Addr_mod_type; Destination : VME_Addr); PROCEDURE VME_Read (Sc : TYPE_ISC ; VAR Data : Short_int ; Transfer_mode : Mode_type;  procedure VME_INIT ; VAR ID : short ; IDReg : ^char ; begin if (Sc < 8) then escape(RangeErr); (*add pau 17.03.86*) if odd (Sc) then escape(OddSelectCode); (*add pau 17.03.86*) if ISC_TABLE[SC].CARD_ID=NO_ID then  Addr_mod : Addr_mod_type; Source : VME_Addr); PROCEDURE VME_Write (Sc : TYPE_ISC ; Data : Short_int ; Transfer_mode :  try id:=0; IDReg:=anyptr(integer(ISC_TABLE[sc].Card_ptr)+1); ID:=ord(idreg^); IF ID=VmeCardId then ISC_TABLE[SC].CARD_ID:=ID; recover ; if isc_table[sc].card_id<>VmeCardId then escape(WrongVmeId); VMEISRTABLE[SC].INTLVL :=Mode_type; Addr_mod : Addr_mod_type; Destination : VME_Addr); PROCEDURE VME_StrRead (Sc : TYPE_ISC ; VAR Data : STRING ;  NIL; VMEISRTABLE[SC].ISRIBVAR:= NIL; vme_reset(sc); END; (* OF VME_INIT *) procedure VME_RESET ; VAR ID : short ; IDReg : ^char ; begin if (Sc < 8) then escape(RangeErr); (*add pau 17.03.86*) if odd (Sc) then e NumOfChar : Short_int ; Transfer_mode : Mode_type; Addr_mod : Addr_mod_type; Source : VME_Addr); PROCEDURE VME_StrWrite (Sc : TYPE_ISCscape(OddSelectCode); (*add pau 17.03.86*) if isc_table[sc].card_id<>VmeCardId then escape(WrongVmeId); VMERESET(SC); end; Procedure VME_BlockRead; begin if (Sc < 8) then escape(RangeErr); (*add pau 17.03.86*) if  ; VAR Data : STRING ; Transfer_mode : Mode_type; Addr_mod : Addr_mod_type; Destination : VME_Addr); PROCEDURE VME_INIT (SC odd (Sc) then escape(OddSelectCode); (*add pau 17.03.86*) if NumOfBytes>0 then begin (*next line changed pau 17.03.86*) if Odd(NumOfBytes) and ((Transfer_Mode=WordInc) or (Transfer_Mode=WordFxd)) then escape(OddNumOfBytes);     hen begin (*next line changed pau 17.03.86*) if Odd(NumOfBytes) and ((Transfer_Mode=WordInc) or (Transfer_Mode=WordFxd)) then escape(OddNumOfBytes); if isc_table[sc].card_id<>VmeCardId then escape(WrongVmeId); Timeouimeout(isc_table[sc].io_tmp_ptr^.timeout); (*next line changed pau 17.03.86*) TRANSFER_IN(SC, SOURCE, StrAddr(DATA), NumOfChar, Addr_mod, ord(Transfer_Mode)); Setstrlen(Data, NumOfChar); end else if NumOfChar<0 then t(isc_table[sc].io_tmp_ptr^.timeout); TRANSFER_OUT(SC,Destination,Data,NumOfBytes,Addr_mod,ord(Transfer_mode)); (*changed pau 17.03.86*) end else if NumOfBytes<0 then escape(NumOfCharErr); end; (* VME_BlockWrite *) PROCEDURE VME_Reaescape(NumOfCharErr); end; (* VME_StrRead *) PROCEDURE VME_StrWrite ; begin if (Sc < 8) then escape(RangeErr); (*add pau 17.03.86*) if odd (Sc) then escape(OddSelectCode); (*add pau 17.03.86*) if strlen(data)>0 thed ; var tmode : Short_int; (*changed pau 17.03.86*) begin if (Sc < 8) then escape(RangeErr); (*add pau 17.03.86*) if odd (Sc) then escape(OddSelectCode); (*add pau 17.03.86*) if isc_table[n begin (*next line changed pau 17.03.86*) if (Transfer_mode>WordInc) then Transfer_mode:=ByteFxd else Transfer_mode:=ByteInc; if isc_table[sc].card_id<>VmeCardId then escape(WrongVmeId); Timeout(isc_table[sc].io_tmp_ptr^.timesc].card_id<>VmeCardId then escape(WrongVmeId); Tmode:= ord(transfer_mode) mod 2; (*changed pau 17.03.86*) Timeout(isc_table[sc].io_tmp_ptr^.timeout); VMEREAD( SC, SOURCE, DATA, Addr_mod, Tmode); end; (* VME_Read *) PROCEDout); (*next line changed pau 17.03.86*) TRANSFER_OUT(SC, DESTINATION, StrAddr(DATA), Strlen(Data), Addr_mod, ord(Transfer_Mode)); end; end; (* VME_StrWrite *) $PAGE$ $debug off,stackcheck off,Range off,Ovflcheck off$ procedure VMURE VME_Write ; var tmode : Short_int; (*changed pau 17.03.86*) begin if (Sc < 8) then escape(RangeErr); (*add pau 17.03.86*) if odd (Sc) then escape(OddSelectCode); (*add pau 17.03.86*) iEISR (t : pisrib ); var Status_IdT, Saveioerror, Saveescape, Int_Level , Selectcode : integer ; begin Saveioerror:=ioresult; Saveescape:=escapecode; (* save previous errorstates *) with t^ do begin SelectCode:=(Integer(intregaddr)-hex('6000f isc_table[sc].card_id<>VmeCardId then escape(WrongVmeId); Tmode:= ord(transfer_mode) mod 2; (*changed pau 17.03.86*) Timeout(isc_table[sc].io_tmp_ptr^.timeout); VMEWRITE( SC, DESTINATION, DATA, Addr_mod, Tmode); end; (* V00')) div hex('10000'); if isc_table[SelectCode].Card_id=VmeCardId then begin try Statusid(SelectCode,Status_IdT,Int_Level); if VmeIsrTable[SelectCode].IntLvl<> nil then call(VmeIsrTable[SelectCode].IntLvl^ME_Write *) PROCEDURE VME_StrRead; begin if (Sc < 8) then escape(RangeErr); (*add pau 17.03.86*) if odd (Sc) then escape(OddSelectCode); (*add pau 17.03.86*) if NumOfChar>0 then begin (*next line chang,Status_IdT,Int_level); if t<>nil then (* prevent reenable interrupt if user had disabled VME_CARD by VME_disableintr(.. . )*) t^.intregaddr^:=chr(128); (* reenable interrupt and release IACed pau 17.03.86*) if (Transfer_mode>WordInc) then Transfer_mode:=ByteFxd else Transfer_mode:=ByteInc; if NumOfChar>Strmax( Data) then escape(NumOfCharErr); if isc_table[sc].card_id<>VmeCardId then escape(WrongVmeId); TK Line *) recover begin t^.intregaddr^:=chr(0); (* disable interrupt *) escape(escapecode); end; ioresult:=SaveIoError; (* resave previous errorstates *) escape(SaveEscape) end e     ibvar); end; if IntLvl^=Userproc then Isribvar^.IntRegaddr^:=chr(128) (* enable interrupt on interface card *) else begin IntLvl^:=UserProc; VmeLinkToChain(Sc); end; end; (* of With *) end;(* procedure  | 5 | not used * ----------------------------------------------------------------------- * 7 | 7 | Bus Status Register * ----------------------------------------------------------------------- * * VME_Enable_Intr *) procedure VME_disable_Intr; var procvar : user_proc; (* temp Procvar for DummyAssignment *) begin if (Sc < 8) then escape(RangeErr); (*add pau 17.03.86*) if odd (Sc) then escape(OddSelectCode); (*add pau 1 Write Registers : * Address + Selectcode | Reg # 1 | Description * ----------------------------------------------------------------------- * 1 | 1 | Reset interface Card * -----------------------------------lse (* Case of no VME Card *) chainflag:=true; end;(* of with t *) end; $stackcheck,Range ,Ovflcheck $ (* changed pau 17.03.86*) procedure VmeLinktoChain(Sc : Type_isc ); var IntReg : charptr ; IntMask,IntValue : byte 7.03.86*) if Isc_table[sc].card_id<>VmeCardId then escape(WrongVmeId); with VmeIsrTable[sc] do begin if IntLvl=nil then else begin VmeUnLinkFromChain(Sc); intlvl^:=procvar; (* assign Intlvl^ to any Procvar:  ; Cardlevel : byte ; begin with VmeisrTable[sc] do begin IntMask:=Intenable+IntOccured; IntValue:=IntMask; IntReg:=anyptr(integer(Isc_Table[Sc].card_ptr)+Intreg3); Cardlevel:=ORD(IntReg^) div 16 mod 4 +3 Purpose : Prevent match(IntLvl^=UserProc) in Vme_Enable_intr *) dispose(IntLvl);dispose(isribvar); end; end;(* of with *) end;(* VME_ISRInstall *) END. (* of Module VME_DRIVER *) ; (* evaluate CardLevel *) isrlink(VmeIsr,IntReg,IntMask,IntValue,Cardlevel,isribvar); IntReg^:=chr(128); (* enable interrupt on interface card *) end ;(* of With *) end; procedure VmeUnLinkFromChain(Sc : Type_isc ); var IntReg * * written by R. Eisenhut BCD R&D 15.OCT.85 * revised by Pedro Alonzo BCD R&D 17.MAR.86, 8.APR.86 * Name 'VME.ASM.TEXT' *********************************************************************** * * * ** ** ********** * *  : charptr ; Cardlevel : byte ; begin with VmeisrTable[sc] do begin IntReg :=anyptr(integer(Isc_Table[Sc].card_ptr)+Intreg3); Cardlevel:=ORD(IntReg^) div 16 mod 4 +3; (* evaluate CardLevel *) IntReg^  * * * * * * * * * * * * * * * * * * *** * ********** * * * * * * * * * * * * * * * * ********** ************************* :=chr(0); (* disable interrupt on interface card *) ISRUNLINK(Cardlevel,isribvar); end ;(* of with *) end;(* of procedure VmeUnLinkFromChain *) procedure VME_Enable_Intr; begin if (Sc < 8) then escape(RangeErr)************************************************** * Read Registers : * Address + Selectcode | Reg # 1 | Description * ----------------------------------------------------------------------- * 1 | 1 | ID Regis; (*add pau 17.03.86*) if odd (Sc) then escape(OddSelectCode); (*add pau 17.03.86*) if Isc_table[sc].card_id<>VmeCardId then escape(WrongVmeId); with VmeIsrTable[sc] do begin if IntLvl=nil then begin new(IntLvl);new(isrter Id= 17 * ----------------------------------------------------------------------- * 3 | 3 | Interrupt Status Register * ----------------------------------------------------------------------- * 5      ------------------------------------ * 3 | 3 | Interrupt Register * ----------------------------------------------------------------------- * 5 | 5 | Higher Address bits * ------------ VME_LOCATION: INTEGER ; SRC Data : SHORT ; SRC AddrModifier: SHORT ; SRC Mode : subtype) ; SRC procedure Trans----------------------------------------------------------- * 7 | 7 | Address Modify & Bus Request * ----------------------------------------------------------------------- * * Reg3_read = record * fer_IN (Selectcode : SHORT ; SRC VME_LOCATION: INTEGER ; SRC Block_Addr : ANYPTR ; SRC Blockcount : INTEGER ; SRC Add true : (INT_ENABLE ,INT_OCCURED ,SWITCH1 ,SWITCH0,NOT USED ,IR2 ,IR1 ,IR0 ); * END; * Reg3_write = record * true : (INT_ENABLE ,NONE ,NONE ,NONE ,NONE ,NONE ,NONE ,IACK ); * END; * rModifier: SHORT ; SRC Mode : subtype) ; SRC procedure Transfer_OUT(Selectcode : SHORT ; SRC VME_LOCATION: INTEGER ; SRC Block_Addr : AN Reg7_write = record * true : ( AM5 , AM4 , AM3 , AM2, AM1 ,AM0, BBSY, BR ); * END; * Reg7_read = record * true : ( false,false,false,false,false,false,BGIN,BCLR ); * YPTR ; SRC Blockcount : INTEGER ; SRC AddrModifier: SHORT ; SRC Mode : subtype) ; SRC Procedure StatusId (Selectcode : SHORT ;  END; * * Interrupt Level switches Switch | 2 | 1 * -------|-----|---- * 3 | 0 | 0 * 4 | 0 | 1 * 5 | 1 | 0 *  SRC VAR Status : INTEGER ; SRC VAR Intlvl : INTEGER); SRC function Straddr(VAR STR:STRING): ANYPTR; SRC procedure TIMEOUT(Millisec : INTEGER ); SRC end; d 6 | 1 | 1 page LIST RORG.L $0000 NOSYMS SPRINT MNAME VME_ASM_DRIVER SRC module VME_ASM_DRIVER; SRC import iodeclarations; SRC export SRC type SRef VME_ASM_DRIVER_VME_ASM_DRIVER def VME_ASM_DRIVER_TIMEOUT def VME_ASM_DRIVER_VMERESET def VME_ASM_DRIVER_VmeRead def VME_ASM_DRIVER_VmeWrite def VME_ASM_DRIVER_StatusId def VME_ASM_DRIVER_TRANSFER_IN def C SHORT = -32768..32767; SRC SUBTYPE = 0..3; SRC Procedure VmeReset (SelectCode : SHORT); SRC Procedure VmeRead (Selectcode : SHORT ; SRC VME_LOCATION: INTEGER ; VME_ASM_DRIVER_TRANSFER_OUT def VME_ASM_DRIVER_STRADDR REFA sysglobals Reg1 equ $1 Reg3 equ $3 Reg5 equ $5 Reg7 equ $7 VME_OFFSET equ  SRC VAR Dat : SHORT ; SRC AddrModifier: SHORT ; SRC Mode : subtype) ; SRC Procedure VmeWrite (Selectcode : SHORT ; SRC  $10000 BREQUEST equ 0 BBUSY equ 1 BG equ 1 IACK equ 0 * Temporary Variables defined here * VAR Vme_base: Pointer to INTEGER ; ***************************************     eturn IntLevel,StatusId * clr.b Reg3(a0) disable INTR move.b Reg3(a0),d0 get Status Reg 3 not d0 Added pau 08.04.86 and.l #$7,d0 Intlvl:=Reg3^ mod 8 move.l d0,d1 lsl #1,d1 clr.l timeout vem.l (sp)+,a0-a2/d0-d1 unlk a6 move.l (sp),14(SP) adda #14,sp rts VME_ASM_DRIVER_VmeWrite link a6,#-WorkSpace movem.l a0-a2/d0-d1,-(sp) move 18(a6),SC(a6) get SelectCode move.b 11(a6),Addr_Modifier(a6) bsr Math move.b #$e4,Reg_7_data(a6) set Addressmodifier for Test purpose bsr RequestBusOnly get VMEbus bset #IACK,Reg3(a0) Set Iack Line low clr.l d2 adda d1,a1 * read not currently implemented because there no interruptable device o_Address bsr Register_init bsr Request_Bus move.b 15(a6),Reg5(a0) write Upper Bits to Reg. 5 clr.l d0 move 16(a6),d0 adda.l d0,a1 get Lower Address Bits move 12(a6),d1 get Dataword tst 8(a6) ************************************ * Locale Variables WorkSpace equ 10 Bytes on Stack Addr_modifier equ -10 Sc equ -08 Vme_Base equ -06 Long Reg_5_data equ n VMEbus * execution of the following operation will cause a BusError move (a1),d2 Read StatusId bclr #IACK,Reg3(a0) Release Iack Line bsr Unrelease_bus movea.l 12(a6),a0 get pointer to StatusId move.l d2,(a0 -02 Word Offset from (a6) Reg_7_data equ -01 Word page VME_ASM_DRIVER_VME_ASM_DRIVER equ * clr.l timeout initialize Timeout for Basic rts Define MODULE * This function return the physical) save StatusId movea.l 8(a6),a0 get Pointer to Intlvl move.l d0,(a0) save Intlvl ReturnfromStatusId movem.l (sp)+,a0/a1/d0-d2 unlk a6 move.l (sp),10(sp) adda #10,sp rts VME_ASM_DRIVER_VMERESET lin Address of the beginning charater from * a 'STRING' VME_ASM_DRIVER_STRADDR movea.l 4(sp),a0 addq #1,A0 move.l a0,10(sp) move.l (sp),6(sp) adda.l #6,sp rts VME_ASM_DRIVER_TIMEOUT move.l 4(sp),timeout move.l (sp),4(sp) ak a6,#-WorkSpace movem.l a0/d0,-(sp) move 8(a6),sc(a6) get SelectCode bsr Math_Address movea.l Vme_Base(a6),a0 move.b d0,Reg1(a0) Force Reset clr.b Reg5(a0) Higher AddressBits movem.l (sp)+,d0/a0 unlkdda.l #4,sp rts timeout dc.l 0 Timeoutspace in Memory *---------------------------------------------------------------------------- * procedure StatusId(Sc : Short ; * var Status : integer  a6 move.l (sp),2(sp) Clean UP Stack addq #2,sp rts VME_ASM_DRIVER_VmeRead link a6,#-Workspace movem.l a0-a2/d0-d1,-(sp) move 20(a6),SC(a6) get SelectCode move.b 11(a6),Addr_Modifier(a6) bsr Math_Address b; * var IntLvl : integer); VME_ASM_DRIVER_StatusId equ * link a6,#-WorkSpace movem.l a0/a1/d0-d2,-(sp) move 16(a6),sc(a6) store SelectCode in StackArea bsr Math_Address bsr Register_init * Descriptiosr Register_init bsr Request_Bus move.b 17(a6),Reg5(a0) write Upper Bits to Reg. 5 clr.l d0 move 18(a6),d0 VME_Addr:=VME_BASE+Lower Address bits adda.l d0,a1 movea.l 12(a6),a2 get Data Pointer tst 8(a6) n * Disable_intr * Read StatusRegister Reg3 * encode Intlevel * request VMEbus * While not BusGrant >>>>> loop * set Bbusy Line * while not BusGrant released do; * set IACK Line low * Read Status ID * Release IACK Line * R bne.s Wordread Byteread move.b (a1),d1 andi #$ff,d1 move d1,(a2) bra.s ReadReturn WordRead move (a1),(a2) * bra.s ReadReturn ReadReturn bsr Unrelease_bus mo     bne.s WordWrite ByteWrite move.b d1,(a1) bra.s WriteReturn WordWrite move d1,(a1) * bra WriteReturn WriteReturn bsr Unrelease_bus movem.l (sp)+,a0-a2/d0-d1 unlk a6 orkSpace Allocate Locale Memoryspace movem.l d0-d7/a0-a4,-(sp) lea JumptableOUT,a3 * a0 ........ Pointer to VME_registers * a1 ........ Pointer to VME_Memory * a3 ........ Pointer  move.l (sp),12(SP) adda.l #12,sp rts page * Attention !!!!!!!! Do not Change the Order of the JumpTable * Transfere_Mode | Increment * ------------------to JumpTable * * d0 ........ lower VME_Memory Bits * d1 ........ blocktransfer Counter * d4 ........ Temporary Offset for conditional jump * a3 ........ Condition jump Register GetPar-|------------ JumptableIN dc.l FByteRead ByteMode | 1 dc.l LWordRead WordMode | 2 dc.l FixByteRead not used | 2 dc.l FixWordRead | 2 JumptableOUT ameters move 24(a6),SC(a6) Copy Selectcode move.b 11(a6),Addr_modifier(a6) bsr Math_Address Evaluate physical Address bsr Register_init bsr Request_bus move 20(a6),d0 high Word of VME_Memory Address  dc.l FByteWrite ByteMode | 1 dc.l LWordWrite WordMode | 2 dc.l FixByteWrite | 2 dc.l FixWordWrite | 2 *--------------------------------------------- move.b d0,Reg_5_data(a6) save 16..23 Addressbits move.b d0,Reg5(a0) Write Higher Address bit to INTERFACE REG 5 clr.l d0 move 22(a6),d0 get Lower 16 bits move.l 12(a6),d1 Xfer Counter move 8(a6),d4 get Mo---------------------------- * procedure Transfer_IN( Selectcode : SHORT ; * VME_LOCATION: Pointer ; * Block_Addr : Pointer ; * Blockcount : INTEGER ; * AddrMde andi #3,d4 Mask Mode(Byte,Word) lsl #2,d4 Data_off movea.l 0(a3,d4),a3 get Procedure address move.l #$10000,d4 Blockcount in D4 jmp (a3) Conditional jump to Execution Routine Return_fromodifier: SHORT ; * Mode : (Byte,Word,FByte,FWord) ; * VME_ASM_DRIVER_TRANSFER_IN equ * link a6,#-WorkSpace Allocate Locale Memoryspace movem.l d0-d7/a0-a4,-(sp) lea JumptableIN,a3 bra GetPar_Xfer bsr Unrelease_bus movem.l (sp)+,d0-d7/a0-a4 Save Registers unlk a6 Deallocate Memoryspace move.l (sp),18(sp) Clean up Stack adda.l #18,sp rts page * Entry Conidition : * d0 Lower 16ameters *------------------------------------------------------------------------- * procedure Transfer_OUT( Selectcode : SHORT ; * VME_LOCATION: Pointer ; * Block_Addr : Pointer ; *  Bit of VmeAddress * d1 Amount of Bytes to be transfered * d4 constant Value of $10000 * d5 . . . . . . keeps VME_Address * a0 . . . . . . VME_BASE Address(Register pointer) * R Blockcount : INTEGER ; * AddrModifier: SHORT ; * Mode : (Byte,Word,FByte,FWord) ; * 0 , 1 , 2 , 3 VME_ASM_DRIVER_TRANSFER_OUT equ * link a6,#-Wead Write Operation * -------------|------------------------------ * a1 . . . . . . SOURCE | DESTINATION ADDRESS * a2 . . . . . . DESTINATION | SOURCE ADDRESS * a3      ords * if not(d6=0) then begin * d6:=d6-1; * call LongXferRoutine; * call Blockincr ; * end; in VME_Base Address * a1 . . . . VME = Source * a2 . . . . VME = Destination VmeReadRegInit movea.l d5,a1 VME_BASE +$10000 >> a1 rts VmeWriteRegInit movea.l d5,a2 rts * Transfer Routines to/from fix VME_ADDRESS with po* while ByteCount do begin * Initalize VME_Address; * d6:=$3fff; * call LongXferRoutine; * call Blockincr; * ByteCount:=Bytecount-$10000; * stincrementing of DataBlockAddress * ByteXfera2 move.b (a1),(a2)+ dbra d6,ByteXfera2 rts ByteXfera1 move.b (a1)+,(a2) dbra d6,ByteXfera1 rts WordXfera1 move (a1)+,(a2) dbra d6,WordXfera1  . . . . . . Address of Transfer Routine * a4 . . . . . . Address of Read/Write initial Routine * a6 . . . . . . Stackframe LWordRead lea VmeReadRegInit,a4 lea LongXfer,a3 move.l a1,d5 Vme_Ba end; * While_end: d6:=ByteCount/2; * if not(d6=0) then begin * if odd(d6) then XferOneWord; * d6:=d6/2-1; * call LongXferRoutine; * RETURN; * * LWordXfer move.l se is Source adda.l d0,a1 movea.l 16(a6),a2 Block Address is Destination bra.s LwordXfer LWordWrite lea VmeWriteRegInit,a4 Used By LWordXfer lea LongXfer,a3 move.l a1,d5 Keep Vme_Base Address addd4,d7 sub.l d0,d7 cmp.l d7,d1 bgt.s Outblock InBlock move.l d1,d6 lsr.l #1,d6 btst #0,d6 beq.s Next2 subq #1,d6 move (a1)+,(a2)+ Next2 lsr #1,d6 beq.s EndOfXfer suba.l d0,a1 movea.l a1,a2 Vme_Base is Destination movea.l 16(a6),a1 Block Address is Source * bra.s LWordXfer * d1 . . . ByteCount total # of Bytes te be transfered * d4 . . . $10000 constant * d6 q #1,d6 jsr (a3) bra.s EndofXfer OutBlock sub.l d7,d1 move.l d7,d6 lsr.l #1,d6 btst #0,d6 beq.s Next subq #1,d6 move (a1)+,(a2)+ Next lsr #1,d6 beq.s EndOfXfer . . . # of Loop in Xfer Routine * d7 . . . TempRegister * if ($10000-LowerAddress)>ByteCount then Outblock * else begin (* InBlock *) * d6:=d1/2; d6 contain now # of Words * if odd(d6) then XferOneWord ;LongXfer  subq #1,d6 jsr (a3) bsr.s LBlockincr While_Loop jsr (a4) While_entry cmp.l d4,d1 ble.s While_End move.l #$3fff,d6 jsr (a3) bsr.s LBlockincr sub.l d4,d1 bra.s While_loop While_Eonly if Even WordCount * d6:=d6/2; d6 contain now # of LongWords * if not(d6=0) then begin * d6:=d6-1; * call LongXferRoutine; * Return ; * nd move.l d1,d6 lsr.l #1,d6 beq.s EndOfXfer btst #0,d6 beq.s next1 subq #1,d6 move (a1)+,(a2)+ Next1 lsr #1,d6 beq.s EndOfXfer subq #1,d6 jsr (a3) EndofXfer  end * Outblock: begin ByteCount:=ByteCount-d7; * d6:=d7/1; * if odd(d6) then XferOneWord ;LongXfer only if Even WordCount * d6:=d6/2; d6 contain now # of LongW bra return_from_xfer * Transfer Routines with post increment of VME_ADDRESS and DataBlockAddress * d6 := Repeat value +1 ; LongXfer move.l (a1)+,(a2)+ dbra d6,LongXfer rts * VME_Base Address Initialize Routine * d5 conta      rts WordXfera2 move (a1),(a2)+ dbra d6,WordXfera2 rts LBlockIncr addq.b #1,Reg_5_data(a6) Next Block move.b Reg_5_data(a6),Reg5(a0) rts page *************************************************************call Xfer Routine FEndOfXfer bra Return_from_xfer * Transfer Routines with post increment of VME_ADDRESS * d6 := Repeat value +1 ; FByteXfer move.b (a1)+,(a2)+ dbra d6,FByteXfer rts page ******************************************* FByteRead lea VmeReadRegInit,a4 lea FByteXfer,a3 move.l a1,d5 Vme_Base is Source adda.l d0,a1 movea.l 16(a6),a2 Block Address is Destination bra.s Byte_Xfer FByteWrite ******************************************************** FixByteRead lea VmeReadRegInit,a4 lea ByteXfera2,a3 move.l a1,d5 Vme_Base is Source adda.l d0,a1 movea.l 16(a6),a2 Block Address is Destination br lea VmeWriteRegInit,a4 Used By LWordXfer lea FByteXfer,a3 move.l a1,d5 Keep Vme_Base Address adda.l d0,a1 movea.l a1,a2 Vme_Base is Destination movea.l 16(a6),a1 Block Address is Source * a.s FixByte_Xfer FixByteWrite lea VmeWriteRegInit,a4 Used By LWordXfer lea ByteXfera1,a3 move.l a1,d5 Keep Vme_Base Address adda.l d0,a1 movea.l a1,a2 Vme_Base is Destination movea.l 16(a6),a1  bra.s Byte_Xfer Byte_Xfer move.l d4,d7 d4 contains $10000 sub.l d0,d7 evaluate # of bytes according to Vme_Startaddress cmp.l d7,d1 # of Bytes < $10000 ? bgt.s FOutblock if d7=$10000 do begin * d6:=$ffff; * call XferRoutine; * end; * if ByteCount<>0 then * d6:=d1-1 ; * Call XferRoutine; * return ; FixByte_Xfer equ * BWhile_Loop cmp.l p.l d4,d1 # of bytes > $10000 ble.s FWhile_End if less or equal then FWhile_end move.l #$ffff,d6 else intialize Loop Counter jsr (a3) and Call Xfer Routine bsr LBlockincr do a Blockincrem d4,d1 blt.s BWhile_End move.l #$ffff,d6 jsr (a3) sub.l d4,d1 bra.s BWhile_Loop BWhile_End move.l d1,d6 beq.s BEndOfXfer lsr.l #1,d6 subq.l #1,d6 jsr (a3) BEndOfXfer bra Return_fent sub.l d4,d1 subtract BytesCounter by $10000 bra.s FWhile_Loop FWhile_End move.l d1,d6 transfer rest of Bytes beq.s FEndOfXfer subq.l #1,d6 initialize Loopcounter jsr (a3) rom_xfer * While ByteCount>=$10000 do begin * d6:=$7fff; * call XferRoutine; * end; * if ByteCount<>0 then * d6:=d1/2 -1 ; * Call XferRoutine; * return ; Word_Xfer equ * WWhile_Loop cmp.l d4,d1 blt.s WWhile     r *4 ; lsl.b #2,d0 move.b d0,Reg_7_data(a6) RequestBusonly bclr #bbusy,Reg_7_data(a6) Clear BBUSY BIT bset #brequest,Reg_7_data(a6) Set BR BIT move.b Reg_7_data(a6),Reg7(a0) Write Address Modifier to Register 7 bsr  BOPFAILED, SRC BBADINTERUPT, SRC BBADSECTOR, SRC BBADCOUNT, SRC BNOTBUBBLE, SRC BBADDATA, SRC BIOFAIL); SRC SRC BBUFP = ^CHAR; SRC  Busready Is VME_BUS Ready ? * IF BUS Ready then Set BBusy Line and Hold BUS bset #bbusy,Reg_7_data(a6) move.b Reg_7_data(a6),Reg7(a0) BusGrReleased btst #bg,Reg7(a0) beq.s BusGrReleased *  INFOPTR = ^INFOREC; SRC CARDPTR = ^INTEGER; SRC SRC BUFREC= RECORD CASE BOOLEAN OF SRC TRUE : (BUFI : INTEGER); SRC FALSE: (BREC : BBUFP); SRC END; SRC SRC INFOREC = RECORD SRC _End move.l #$7fff,d6 jsr (a3) sub.l d4,d1 bra.s WWhile_Loop WWhile_End move.l d1,d6 beq.s WEndOfXfer lsr.l #1,d6 subq.l #1,d6 jsr (a3) WEndOfXfer bra Return_from_xfer page *-- Clear Bus Request bit bclr #brequest,Reg_7_data(a6) move.b Reg_7_data(a6),Reg7(a0) rts Unrelease_bus bclr #bbusy,Reg_7_data(a6) bclr #brequest,Reg_7_data(a6) move.b Reg_7_data(a6),Reg7(a0) rts * ---------------------------------------------------------------------- * Evaluate Interface physical Address * Sc Located on Stack Area * if odd(sc) then escape 801; * if Sc>7 and Sc<32 then begin * A0:=Sc*$10000+$600000; * end * else * While not (odd(Reg_3)) or (Timeout) do Busready tst.l Timeout beq.s No_timeout move.l Timeout,d0 initialize Timeout Counter lsl.l #8,d0 multiply by 256 Busreadyloop btst #bg,Reg7(a0) beq.s escape 800; * Math_Address move sc(a6),d0 ext.l d0 *DEL PAU 14.03.86 cmpi #7,d0 *DEL PAU 14.03.86 bgt.s Low_ok *DEL PAU 14.03.86 bra Sc_error *DEL PAU 14.03.86 Low_ok cmpi #32,d0 *DEL PAU 1Busreadyloopexit subq.l #1,d0 bmi Timeout_Err bra.s Busreadyloop Busreadyloopexit rts No_timeout btst #bg,Reg7(a0) bne.s No_timeout rts Register_init movea.l Vme_base(a6),a0 movea.l a0,a1 adda4.03.86 bge Sc_error *DEL PAU 14.03.86 btst #0,d0 *DEL PAU 14.03.86 bne OddScErr *DEL PAU 14.03.86 Sc_ok equ * mulu #$1,d0 swap d0 add.l #$600000,d0 move.l d0,Vme_base(a6) .l #vme_offset,a1 rts end rts *DEL PAU 14.03.86 Sc_error move #800,sysglobals-2(a5) *DEL PAU 14.03.86 trap #10 *DEL PAU 14.03.86 OddScErr move #801,sysglobals-2(a5) *DEL PAU 14.03.86 trap #10 Timeout_Err move #8* BUBBLE MEMORY CARD READ/WRITE DRIVERS * 11 JAN 1983 * NOSYMS * MNAME BUB_DVR DEF BUB_DVR_BUB_DVR DEF BUB_DVR_BUBGETINFO DEF BUB_DVR_BUBDORESET DEF BUB_DVR_BUBDOREAD DEF BUB_DVR_BUBDOWRITE DEF BUB_DVR_BUBDOISR02,sysglobals-2(a5) trap #10 *---------------------------------------------------------------------------- Request_bus clr.b Reg7(a0) Release AM5-AM0, BBSY,BR move.b Addr_modifier(a6),d0 Reg_7_Data :=Addr_modifie PAGE SRC MODULE BUB_DVR; SRC EXPORT SRC TYPE SRC BSTATETYPE = (B_IDLE, SRC B_READING, SRC B_WRITING); SRC SRC BERRORTYPE = (BNOERROR, SRC BTIMEOUT, SRC       MAXBYTES : INTEGER; SRC PRIORITY : 0..255; SRC RUNSTATE : BSTATETYPE; SRC ERRORCODE: BERRORTYPE; SRC SRC BSTART : INTEGER; SRC BBUFFER : BUFREC; SRC  EQU 42 LONG * * CARD OFFSETS CARD_ID EQU 1 INT_REG EQU 3 INFO_REG EQU 5 DATA_REG EQU 9 COMMAND EQU 11 STATUS EQU 11 * * STATUS BITS BUSY EQU 7 OP_DBCOUNT : INTEGER; SRC BRETRY : INTEGER; SRC SRC BSPAGE : INTEGER; SRC BUFSTART : BBUFP; SRC BUFADDR : BBUFP; SRC BUFEND : BBUFP; SRC BLOCKSIZE: ONE EQU 6 OP_FAIL EQU 5 TIME_ERR EQU 4 CORRECTABLE EQU 3 UNCORRECT EQU 2 PARITY_ERR EQU 1 FIFO_AVAIL EQU 0 PAGE * INTERUPT REG BITS INT_E EQU 7 ENABLED INT_R INTEGER; SRC END; SRC SRC PROCEDURE BUBGETINFO(ANYVAR CARD : CARDPTR; ANYVAR INFO : INFOPTR); SRC SRC PROCEDURE BUBDORESET(ANYVAR CARD: CARDPTR; ANYVAR INFO : INFOPTR); SRC SRC PROCEDURE BUBDOREAD(ANYVAR CARD : CARDPTR; ANY EQU 6 REQUESTED * * BUBBLE COMMAND CODES WRT_MASKED EQU 16 INITIALIZE EQU 17 READ_DATA EQU 18 WRITE_DATA EQU 19 READ_SEEK EQU 20 READ_LOOP_REG EQU 21 WRT_LOOP_REG EQU 22 VAR INFO : INFOPTR); SRC SRC PROCEDURE BUBDOWRITE(ANYVAR CARD : CARDPTR; ANYVAR INFO : INFOPTR); SRC SRC PROCEDURE BUBDOISR(ANYVAR CARD : CARDPTR; ANYVAR INFO : INFOPTR); SRC SRC END; PAGE * EQUATES FOR RECORD OFFSETS AND CARD OPERATIWRT_LOOP EQU 23 READ_FSA EQU 24 ABORT_CMD EQU 25 WRT_SEEK EQU 26 READ_LOOP EQU 27 READ_CORRECT EQU 28 RESET_FIFO EQU 29 MBM_PURGE EQU 30 SOFT_RESET EQU 31 CLEAR_INT ONS * INFOP EQU A0 CARDP EQU A1 STATUSP EQU A2 COMMANDP EQU A2 DATAP EQU A3 BUFFP EQU A4 * * RUNSTATES B_IDLE EQU 0 B_READING EQU 1 B_WRITING  EQU 32 CLEAR INTERUPT * * REG ADDRESS COUNTER VALUES UTILITY EQU 10 UTILITY REGISTER BLR_LSB EQU 11 BLOCK LENGTH REG LSB BLR_MSB EQU 12 BLOCK LENGTH REG MSB ENABLE EQU 13 EQU 2 * * ERRORCODES BNOERROR EQU 0 BTIMEOUT EQU 1 BOPFAILED EQU 2 BBADINTERUPT EQU 3 BBADSECTOR EQU 4 BBADCOUNT EQU 5 BNOTBUBBLE EQU 6 BBADDATA EQU 7 BIOFAIL E ENABLE REGISTER ADDR_LSB EQU 14 ADDRESS LSB ADDR_MSB EQU 15 ADDRESS MSB FIFO EQU 00 FIFO DATA BUFFER * * CARD INTERUPT ENABLE/DISABLE ENABLE_INTS EQU 128 DISABLE_INTS EQU 000 * * QU 8 * * INFO RECORD OFFSETS MAXBYTES EQU 0 INTEGER PRIORITY EQU 4 WORD RUNSTATE EQU 6 WORD ERRORCODE EQU 8 WORD BSTART EQU 10 INTEGER BBUFFER EQU 14 MISC CONSTANTS PAGESIZE EQU 64 CODE EXPLICITY ASSUMES THIS VALUE MAXPAGES EQU 2048 PAGE * * INTERNAL ROUTINE TO WAIT FOR A COMMAND TO FINISH. * HAS A TIME OUT LIMIT * DC.W 0 COMMAND_DONE EQU * LINK  LONG BCOUNT EQU 18 INTEGER BRETRY EQU 22 INTEGER BSPAGE EQU 26 INTEGER BUFSTART EQU 30 LONG BUFADDR EQU 34 LONG BUFEND EQU 38 LONG BLOCKSIZE  A6,#0 MOVEA.L 8(A6),CARDP LEA STATUS(CARDP),STATUSP CLR.B 12(A6) COMMAND_DONE := FALSE MOVEQ #-1,D0 MAXIMUM COUNT FOR TIMEOUT R76 BTST #INT_R,INT_REG(CARDP) WAIT FOR INTERUPT REQUEST DBNE D0,R76 BNE.S R142      BITS BNE.S GI_EXIT * NO PROBLEMS SO FILL IN MAXBYTES AND PRIORITY CLR.W ERRORCODE(INFOP) ERRORCODE := BNOERROR ANDI.L #7,D0 GET SIZE FIELD ADDQ.L #1,D0 ADD 1 MOVEQ #10,D1 MULTIPLY BY 10D CARD ADDRESS * -20 SAVED INFO RECORD ADDRESS * DC.W 0 BUB_DVR_BUBDORESET EQU * LINK A6,#-20 MOVE.L 12(A6),-(SP) CARD MOVE.L 8(A6),-(SP) INFO JSR BUBGETINFO FILL IN INFO FIELDS AND CHECK CARD TYPE M24 ASL.L D1,D0 BTST #5,INFO_REG(CARDP) 1 MEG OR 4 MEG PARTS BEQ.S R356 MOVEQ #9,D1 4 MEG PARTS ASL.L D1,D0 MULTIPLY BY 512 BRA.S R366 R356 ASL.L #7,D0 1 MEG PARTS MULTIPLY BY 128 R366 MOVE.L D0,(INFOP) SET MAOVEA.L 8(A6),A0 GET INFOREC POINTER MOVEA.L (A0),INFOP TST.W ERRORCODE(INFOP) BNE RS_EXIT MOVE.L INFOP,-20(A6) SAVE INFOP MOVEA.L 12(A6),A1 MOVEA.L (A1),CARDP MOVE.L CARDP,-16(A6) SAVE CARDP MOVE.B #0,CARD_ID(CARDP) RESETBRA.S CD_EXIT NO INTERUPT R142 MOVEQ #-1,D0 RE-INIT LOOP JWS 7/11/85 R140 BTST #BUSY,(STATUSP) WAIT FOR NOT BUSY DBEQ D0,R140 BEQ.S R152 BRA.S CD_EXIT BUSY DIDN'T GO AWAY R15XBYTES MOVE.B INT_REG(CARDP),D0 GET PRIORITY LSR.W #4,D0 FROM FIELD OF INTERUPT REG ON CARD ANDI.W #3,D0 ADDQ.W #3,D0 MOVE.W D0,PRIORITY(INFOP) GI_EXIT UNLK A6 MOVEA.L (SP)+,A0 ADDQ.W #8,SP JMP (A0) PAGE * * IN2 BTST #OP_DONE,(STATUSP) CHECK STATUS BEQ.S R190 COMMAND FAILED MOVE.B #1,12(A6) COMMAND_DONE := TRUE; R190 MOVE.B #CLEAR_INT,(COMMANDP) CLEAR INTERUPT REQUEST R196 BTST #INT_R,INT_REG(CARDP) TERNAL ROUTINE TO LOAD THE BUBBLE CONTROLER * PARAMETER REGISTERS PRIOR TO MAJOR OPERATIONS * DC.W 0 INITIALREGS EQU * LINK A6,#0 MOVEA.L 16(A6),CARDP MOVEA.L 12(A6),INFOP LEA DATA_REG(CARDP),DATAP MOVE.B #BLR_LSB,COM WAIT FOR IT TO GO AWAY BNE.S R196 CD_EXIT UNLK A6 MOVEA.L (SP)+,A0 ADDQ.W #4,SP JMP (A0) PAGE * EXTERNAL ENTRY POINT TO GET CONFIGURATION INFO * ABOUT THE CARD * ALSO USED BY BUBDORESET,BUBDOREAD MAND(CARDP) point RAC at BLR_LSB MOVE.B BLOCKSIZE+3(INFOP),(DATAP) set LSB of BLOCK LENGTH REG. MOVE.B BLOCKSIZE+2(INFOP),D0 get msb ADD.W #16,D0 set bit to use 2 FSA channels MOVE.B D0,(DATAP) set MSBAND BUBDOWRITE * TO VALIDATE THE CARD TYPE AND GET MAXBYTES * ( THE SIZE OF THE BUBBLE MEMORY UNIT ) DC.W 0 BUB_DVR_BUBGETINFO EQU * BUBGETINFO EQU * LINK A6,#0 MOVEA.L 8(A6),A0 INFOP MOVEA.L ( of BLOCK LENGTH REG. MOVEQ #0,D1 clear MFBTR bit enable burst on last page ADD.L 8(A6),D1 add in operation peculiar bits from parameter list MOVE.B D1,(DATAP) set ENABLE REG. MOVE.B BSPAGE+3(INFOP),(DATAP) A0),INFOP MOVEA.L 12(A6),A1 CARDP MOVEA.L (A1),CARDP CLR.W RUNSTATE(INFOP) RUNSTATE := B_IDLE MOVE.W #BNOTBUBBLE,ERRORCODE(INFOP) ERRORCODE := BNOTBUBBLE CMPI.B #30,CARD_ID(CARDP) CHECK CARD ID BNE.S GI_EX set LSB of ADDRESS REG. MOVE.B BSPAGE+2(INFOP),(DATAP) set MSB of ADDRESS REG. UNLK A6 MOVEA.L (SP)+,A0 ADDA.W #12,SP JMP (A0) PAGE * * EXTERNAL ENTRY POINT TO "INITIALIZE" THE * BUBBLE MEMORY CONTROLEIT MOVE.B INFO_REG(CARDP),D0 COPY INFO REG INTO D0 BTST #7,D0 CHECK EXTENSION BIT OF INFO_REG BNE.S GI_EXIT BTST #4,D0 CHECK FSA FIELD OF INFO_REG BNE.S GI_EXIT BTST #3,D0 BOTH R FOR READ/WRITE OPERATIONS * ALSO USED TO ABORT ANY CURRENT READ/WRITE OPERATION * (A6) * -4 BITCOUNT * -8 BYTECOUNT * -12 ABORT RETRY COUNTER * -16 SAVE      THE CARD MOVE.L #300,D0 KILL AT LEAST 200 MICRO SECONDS (rdq) WAIT200 DBF D0,WAIT200 *** TIMEING LOOP *** MOVE.B #3,-12(A6) SET RETRY COUNT FOR ABORT COMMAND R700 LEA COMMAND(CARDP),COMMANDP * DP) READ BOOT LOOP REGISTER R1018 BTST #INT_R,INT_REG(CARDP) WAIT FOR INTERUPT BEQ R1018 R1040 CLR.L -4(A6) BITCOUNT := 0 CLR.L -8(A6) BYTECOUNT := 0 R1048 BTST #BUSY,STATUS(CARDP) WHILE BUSY DO  ENABLE INTERUPTS ON OPDONE MOVE.B #ENABLE,(COMMANDP) POINT RAC AT ENABLE REG MOVE.B #1,DATA_REG(CARDP) SET ENABLE REG MOVE.B #ABORT_CMD,(COMMANDP) ABORT ANY CURRENT OPERATION SUBQ.L #2,SP SPACE FOR FUNCTIONBEQ.S R1124 R1068 BTST #FIFO_AVAIL,STATUS(CARDP) WHILE FIFO_AVAIL DO BEQ R1048 IF FIFO EMPTY THEN CHECK BUSY ADDQ.L #1,-8(A6) INCREMENT BYTECOUNT MOVE.B DATA_REG(CARDP),D0 READ THE DATA BYTE *  VALUE MOVE.L CARDP,-(SP) CARD^ JSR COMMAND_DONE WAIT FOR IT TO FINISH TST.B (SP)+ DID IT FINISH OK ? BNE.S R800 IF FINISHED OK THEN PROCEEDE SUBQ.B #1,-12(A6) DECRIMENT RETRY COUNTER BEQ R1176 IF COUN COUNT THE 1 BITS IN LOW BYTE OF D0 MOVEQ #0,D1 COUNT := 0 MOVEQ #7,D2 LOOP COUNTER MOVEQ #0,D3 ZERO CONSTANT COUNTL LSL.B #1,D0 SHIFT HI BIT TO X ADDX.B D3,D1 ADD 0 + X + COUNT { WILL NEVER BE MORE THAN 8 } DBRA D2,COUT DONE THEN GIVE UP MOVEA.L -16(A6),CARDP RELOAD CARDP BRA R700 TRY AGAIN R800 MOVEA.L -20(A6),INFOP RETRIEVE INFOP MOVE.L MAXBYTES(INFOP),D7 BSPAGE := MAXBYTES DIV 64 - 1; ASR.L #6,D7 DIV 64 SUBQ.L #1,D7 - NTL ADD.L D1,-4(A6) ADD COUNT TO BIT COUNT BRA R1068 END WHILE FIFO_AVAIL R1124 MOVEQ #40,D1 MUST HAVE EXACTLY 40 BYTES CMP.L -8(A6),D1 BNE.S R1150 CMPI.L #270,-4(A6) MUST HAVE EXACTLY 270 BITS BEQ.S RS_EXIT R11 MOVE.L D7,BSPAGE(INFOP) MOVE.L #1,BLOCKSIZE(INFOP) BLOCKSIZE := 1 PAGE MOVE.L -16(A6),-(SP) CARD^ MOVE.L INFOP,-(SP) INFO^ MOVE.L #$21,-(SP) ENABLE RCD AND OPDONE FUNCTIONS JSR INITIALREGS FIXUP THE PARAMETER REGS MOV150 MOVEA.L -20(A6),INFOP WRONG BYTE / BIT COUNT MOVE.W #BOPFAILED,ERRORCODE(INFOP) BRA.S RS_EXIT R1162 MOVEA.L -20(A6),INFOP INITIALIZE OPERATION FAILED MOVE.W #BOPFAILED,ERRORCODE(INFOP) BRA.S RS_EXIT R1176 MOVEA.L -20(A6),INFOP FAIEA.L -16(A6),CARDP RETRIEVE CARDP LEA STATUS(CARDP),STATUSP { STATUSP is same as COMMANDP } MOVE.B #INITIALIZE,COMMAND(CARDP) R922 BTST #INT_R,INT_REG(CARDP) WAIT FOR INTERUPT BEQ R922 (ON FIFO HALF FULL) R944 LED TO RESPOND TO ABORT COMMAND MOVE.W #BTIMEOUT,ERRORCODE(INFOP) RS_EXIT UNLK A6 MOVEA.L (SP)+,A0 ADDQ.W #8,SP JMP (A0) PAGE * * FINAL STAGE OF BUBDOREAD * ALSO USED BY BUBDOISR TO RESTART A FAILED READ OPERATION * BTST #BUSY,(STATUSP) WAIT FOR NOT BUSY BNE R944 BTST #OP_DONE,(COMMANDP) DID IT WORK ? BEQ R1162 MOVE.L CARDP,-(SP) CARD^ MOVEA.L 8(A6),A1 MOVE.L (A1),-(SP) INFO^ MOVE.L #$21,-(SP) ENABLE RCD AND OPDONE FUN (A6) * -4 SAVED CARD ADDRESS * -8 SAVED INFO RECORD ADDRESS * DC.W 0 STARTREAD EQU * LINK A6,#-8 MOVEA.L 12(A6),A1 CARD MOVE.L (A1),-4(A6) MOVEA.L 8(A6),A0 INFO MOVE.L (A0CTIONS JSR INITIALREGS FIX PARAMETER REGS * { THIS ALSO STOPS CURRENT INTERUPT } MOVEA.L -16(A6),CARDP RETRIEVE CARDP LEA STATUS(CARDP),STATUSP { STATUSP is same as COMMANDP } MOVE.B #READ_LOOP_REG,(COMMAN),-8(A6) MOVEA.L (A0),INFOP INFO^ CLR.W RUNSTATE(INFOP) RUNSTATE := B_IDLE CLR.W ERRORCODE(INFOP) ERRORCODE := BNOERROR MOVEA.L -4(A6),CARDP CARD^ MOVE.B #ENABLE,COMMAND(CARDP) SET RAC TO ENABLE REG. MOVE.B #1,DATA_REG(C     R1428 R1420 MOVE.W #BBADSECTOR,ERRORCODE(INFOP) BRA RD_EXIT R1428 MOVE.L BCOUNT(INFOP),D1 CHECK BYTE COUNT BLE.S R1450 MUST BE GREATER THAN ZERO ADD.L D1,D0 BCOUNT + BSTART CMP.L (INFOP),D0 CAN'T BE GREAVEA.L -4(A6),CARDP MOVE.B #RESET_FIFO,COMMAND(CARDP) CLEAR/RESET THE FIFO SUBQ.L #2,SP SPACE FOR FUNCTION VALUE MOVE.L CARDP,-(SP) CARD^ JSR COMMAND_DONE WAIT FOR FIFO TO RESET TST.B (SP)+ DID IT WORK ? BEQ.S TER THAN MAXBYTES BLE.S R1456 R1450 MOVE.W #BBADCOUNT,ERRORCODE(INFOP) BRA.S RD_EXIT R1456 MOVE.B #DISABLE_INTS,INT_REG(CARDP) DISABLE CARD INTERUPTS MOVE.L D1,BUFEND(INFOP) SET COUNT IN BUFEND * CALCULATE NUMBER OF PA R1734 MOVEA.L -8(A6),INFOP OK SO CONTINUE MOVE.L BUFSTART(INFOP),BUFADDR(INFOP) SET BUFFER ADDRESS MOVE.W #B_WRITING,RUNSTATE(INFOP) SHOW NOW WRITING MOVEA.L -4(A6),CARDP MOVE.B #ENABLE_INTS,INT_REG(CARDP) ENABLE CARD INTERUPTS MOVEARDP) ENABLE INTERUPT ON OPDONE MOVE.B #RESET_FIFO,COMMAND(CARDP) CLEAR THE FIFO SUBQ.L #2,SP SPACE FOR FUNCTION VALUE MOVE.L CARDP,-(SP) CARD^ JSR COMMAND_DONE WAIT FOR IT TST.B (SP)+ DID GES FOR THIS OPERATION * PAGE SIZE IS ASSUMED TO BE 64 BYTES ADD.L #63,D1 ROUND UP BYTECOUNT ASR.L #6,D1 DIVIDE BY 64 D1 IS NOW NUMBER OF PAGES CMPI.L #MAXPAGES,D1 CLIP IT AT MAXPAGES BLT.S R1480 MOVE.L #IT WORK ? BEQ.S R1332 MOVE.L -4(A6),-(SP) CARD^ MOVE.L -8(A6),-(SP) INFO^ MOVE.L #$21,-(SP) ENABLE RCD AND OPDONE FUNCTIONS JSR INITIALREGS FIX CONTROL REGS. MOVEA.L -8(A6),INFOP MOVE.L BUFSTART(INFOP),BUFADDR(INFOP) SET BUMAXPAGES,D1 R1480 MOVE.L D1,BLOCKSIZE(INFOP) * CALCULATE START PAGE FOR THIS OPERATION MOVE.L BSTART(INFOP),D0 ASR.L #6,D0 DIVIDE BY 64 MOVE.L D0,BSPAGE(INFOP) MOVE.L BBUFFER(INFOP),D0 GET CURRENT START OF BUFFER MOVE.L D0,BFFER ADDRESS MOVE.W #B_READING,RUNSTATE(INFOP) SHOW NOW READING MOVEA.L -4(A6),CARDP MOVE.B #ENABLE_INTS,INT_REG(CARDP) ENABLE CARD INTERUPTS MOVE.B #READ_DATA,COMMAND(CARDP) START READ OPERTATION BRA.S SR_EXIT R1332 MOVEA.L -8(AUFSTART(INFOP) MARK START OF BUFFER ADD.L D0,BUFEND(INFOP) MARK END OF BUFFER (ADD ADDRESS TO COUNT) MOVE.L 12(A6),-(SP) CARD MOVE.L 8(A6),-(SP) INFO JSR STARTREAD FINISH UP AND ISSUE THE READ COMMAND RD_EXIT UNLK A6 MOVEA.6),INFOP RESET FIFO FAILED MOVE.W #BTIMEOUT,ERRORCODE(INFOP) SR_EXIT UNLK A6 MOVEA.L (SP)+,A0 ADDQ.W #8,SP JMP (A0) PAGE * * EXTERNAL ENTRY POINT TO START DATA READ OPERATIONS * DC.W 0 BUB_DVR_BUBDOREAD EQUL (SP)+,A0 ADDQ.W #8,SP JMP (A0) PAGE * * FINAL STAGE OF BUBDOWRITE * ALSO USED BY BUBDOISR TO RESTART A FAILED WRITE OPERATION * (A6) * -4 SAVED CARD ADDRESS * -8 SAV * LINK A6,#0 MOVE.L 12(A6),-(SP) CARD MOVE.L 8(A6),-(SP) INFO JSR BUBGETINFO FILL INFO FIELDS AND CHECK THE CARD TYPE MOVEA.L 8(A6),A0 MOVEA.L (A0),INFOP INFO^ TST.W ERRORCODE(INFOP) IF ERRORCODE<>BNOERROR BNED INFO RECORD ADDRESS * DC.W 0 STARTWRITE EQU * LINK A6,#-8 MOVEA.L 12(A6),A0 CARD MOVE.L (A0),-4(A6) SAVE CARD^ MOVEA.L 8(A6),A0 INFO MOVEA.L (A0),INFOP INFO^ MOVE.L INFOP,-8(A6) SAVE INFO^ CLR.W RUNSTAE RD_EXIT THEN QUIT MOVEA.L 12(A6),A1 MOVEA.L (A1),CARDP CARD^ MOVE.L BSTART(INFOP),D0 CHECK STARTING POSITION (BYTE) BMI.S R1420 CAN'T BE NEGATIVE TST.B D0 MUST BE MULTIPLE OF 256 BEQ.S TE(INFOP) RUNSTATE := B_IDLE CLR.W ERRORCODE(INFOP) ERRORCODE:= BNOERROR MOVE.L -4(A6),-(SP) CARD^ MOVE.L INFOP,-(SP) INFO^ MOVE.L #$21,-(SP) ENABLE RCD AND OPDONE FUNCTIONS JSR INITIALREGS FIX CONTROL REGS. MO     .B #WRITE_DATA,COMMAND(CARDP) START THE OPERATION BRA.S SW_EXIT R1734 MOVEA.L -8(A6),INFOP FIFO RESET FAILED MOVE.W #BTIMEOUT,ERRORCODE(INFOP) SW_EXIT UNLK A6 MOVEA.L (SP)+,A0 ADDQ.W #8,SP JMP (A0) PAGE * *  CONVERT BLOCKSIZE BACK TO BYTES MOVE.L D1,BUFEND(INFOP) SAVE IT IN BUFEND * CALCULATE START PAGE FOR THIS OPERATION MOVE.L BSTART(INFOP),D0 ASR.L #6,D0 DIVIDE BY 64 MOVE.L D0,BSPAGE(INFOP) MOVE.L BBUFFER(INFOP EXTERNAL ENTRY POINT TO START DATA WRITE OPERATIONS * (A6) * -4 UNUSED (COMPILER TEMP OPTIMIZED OUT) * -8 SAVED CARD ADDRESS * -12 SAVED INFO RECORD ADDRESS * DC.W 0 BUB),D0 GET CURRENT START OF BUFFER MOVE.L D0,BUFSTART(INFOP) MARK START OF BUFFER ADD.L D0,BUFEND(INFOP) MARK END OF BUFFER (ADD ADDRESS TO SIZE) MOVE.L 12(A6),-(SP) CARD MOVE.L 8(A6),-(SP) INFO JSR STARTWRITE FINISH UP AND IS_DVR_BUBDOWRITE EQU * LINK A6,#-12 MOVE.L 12(A6),-(SP) CARD MOVE.L 8(A6),-(SP) INFO JSR BUBGETINFO FILL IN INFO FIELDS AND CHECK THE CARD TYPE MOVEA.L 8(A6),A0 MOVEA.L (A0),INFOP TST.W ERRORCODE(INFOP) IF ERRORSUE THE WRITE COMMAND WT_EXIT UNLK A6 MOVEA.L (SP)+,A0 ADDQ.W #8,SP JMP (A0) PAGE * * INTERUPT SERVICE ROUTINE * DC.W 0 BUB_DVR_BUBDOISR EQU * LINK A6,#0 MOVEA.L 12(A6),A1 GET CARD ADDRESS MOVEACODE <> BNOERROR BNE WT_EXIT THEN EXIT MOVEA.L 12(A6),A1 MOVE.L (A1),-8(A6) CARD^ MOVEA.L 8(A6),A0 MOVEA.L (A0),INFOP INFO^ MOVE.L INFOP,-12(A6) MOVE.L BSTART(INFOP),D0 CHECK STARTING POSITION (BYTE) BMI.S R.L (A1),CARDP CARD BASE ADDRESS LEA STATUS(CARDP),STATUSP STATUS REG ADDRESS LEA DATA_REG(CARDP),DATAP DATA REG ADDRESS MOVEA.L 8(A6),A0 GET INFOREC ADDRESS MOVEA.L (A0),INFOP INFOREC BASE ADDRESS MOVEA.L 1820 CAN'T BE NEGATIVE TST.B D0 MUST BE MULTIPLE OF 256 BEQ.S R1830 R1820 MOVE.W #BBADSECTOR,ERRORCODE(INFOP) BRA WT_EXIT R1830 MOVE.L BCOUNT(INFOP),D1 CHECK BYTECOUNT BLE.S R1860 BUFADDR(INFOP),BUFFP BUFFER ADDRESS CMPI.W #B_READING,RUNSTATE(A0) JUMP ACCORDING TO RUNSTATE BEQ.S READING BGT WRITING * IN B_IDLE STATE ... HAVE UNEXPECTED INTERUPT IDLE MOVE.W #BBADINTERUPT,ERRORCODE(INFOP) set ERRORCODE MOVE. MUST BE GREATER THAN ZERO TST.B D1 BNE.S R1860 MUST BE MULTIPLE OF 256 ADD.L D1,D0 CMP.L (A0),D0 IF (BCOUNT+BSTART)<=MAXBYTES BLE.S R1876 THEN CONTINUE R1860 MOVE.W #BBADCOUNT,ERRORCODE(INFOP) B #DISABLE_INTS,INT_REG(CARDP) disable interupt enable IDLE1 BTST #INT_E,INT_REG(CARDP) wait for enable bit to clear BNE.S IDLE1 BRA ISRDONE all done * IN B_READING ... HAVE DATA OR END OF OPERATION READING BTST BRA WT_EXIT R1876 MOVEA.L -8(A6),CARDP CARD^ MOVE.B #DISABLE_INTS,INT_REG(CARDP) DISABLE CARD INTERUPTS * CALCULATE NUMBER OF PAGES FOR THIS OPERATION * PAGE SIZE IS ASSUMED TO BE 64 BYTES ASR.L  #BUSY,(STATUSP) BEQ.S R2232 * BUSY SO HAVE DATA TO READ MOVE.L BUFEND(INFOP),D0 GET END OF BUFFER ADDRESS R2132 CMP.L BUFFP,D0 CHECK BUFFER AGAINST END OF BUFFER BEQ.S R2143 BTST #FIFO_AVAIL,(STATUSP) #6,D1 DIVIDE BY 64 D1 IS NOW NUMBER OF PAGES CMPI.L #MAXPAGES,D1 CLIP IT AT MAXPAGES BLT.S R1880 MOVE.L #MAXPAGES,D1 R1880 MOVE.L D1,BLOCKSIZE(INFOP) * FOR WRITE OPS, BUFEND IS END OF SEGMENT ASL.L #6,D1 CHECK FIFO BEQ.S R2135 R2133 MOVE.B (DATAP),(BUFFP)+ READ THE DATA BRA.S R2132 R2135 MOVE.L BUFFP,BUFADDR(INFOP) PUT BACK BUFFER ADDRESS BRA ISRDONE THEN EXIT R2143 MOVE.L BUFFP,BUFADDR(INFOP) PUT BACK      12 BTST #FIFO_AVAIL,(STATUSP) CHECK THE FIFO BEQ.S R2440 MOVE.B (DATAP),D1 DISCARD THE DATA BRA.S R2412 R2440 MOVE.L BUFFP,BUFADDR(INFOP) PUT BACK THE BUFFER ADDRESS MOVE.B #CLEAR_INT,(COMMANDP) CLEAR THE INTERUPT REQUEST R24 R2820 * SOMETHING WENT WRONG SO TRY TO RESTART R2750 MOVE.B #CLEAR_INT,(COMMANDP) CLEAR THE INTERUPT R2752 BTST #INT_R,INT_REG(CARDP) WAIT FOR IT TO GO AWAY BNE.S R2752 SUBQ.L #1,BRETRY(INFOP) CHECK THE RETR54 BTST #INT_R,INT_REG(CARDP) WAIT FOR IT TO GO AWAY BNE.S R2454 CMP.L BUFFP,D0 IF ALL DATA READ BEQ R3008 THEN OPERATION COMPLETED MOVE.L BLOCKSIZE(INFOP),D0 INCREMENT START PAGE ADD.L D0,BSPAGE(INFOP) Y COUNTER BLT.S R2806 MOVE.L 12(A6),-(SP) TRY AGAIN MOVE.L 8(A6),-(SP) JSR STARTWRITE BRA.S ISRDONE * TOO MANY RETRIES R2806 CLR.W RUNSTATE(INFOP) SET RUNSTATE TO B_IDLE MOVE.W #BIOFAIL,ERRORCODE(INFOP) BRA.S ISRDONBUFFER ADDRESS * THEN DISCARD UNWANTED DATA R2196 BTST #FIFO_AVAIL,(STATUSP) CHECK FIFO BEQ ISRDONE EXIT IF FIFO IS EMPTY MOVE.B (DATAP),D0 READ & DISCARD BRA.S R2196 *  MOVE.L BUFADDR(INFOP),D0 MOVE.L D0,BUFSTART(INFOP) SET NEW BUFFER ADDRESS * CALCULATE BLOCKSIZE FOR THIS OPERATION SUB.L BBUFFER(INFOP),D0 MOVE.L BCOUNT(INFOP),D1 SUB.L D0,D1 D1 NOW IS BYTES LEFT *  NOT BUSY SO END OF OPERATION * DID ANYTHING GO WRONG ? R2232 BTST #TIME_ERR,(STATUSP) BNE.S R2240 BTST #OP_FAIL,(STATUSP) BNE.S R2240 BTST #UNCORRECT,(STATUSP) BEQ.S R2348 MOVE.W #BBADDATA,ERRORCODE(INFOP)  PAGE SIZE IS ASSUMED TO BE 64 BYTES ADD.L #63,D1 ROUND UP R2550 ASR.L #6,D1 DIVIDE BY 64 D1 IS NOW NUMBER OF PAGES CMPI.L #MAXPAGES,D1 CLIP IT AT MAXPAGES BLT.S R2586 MOVE.L #MAXPAGES,D1 R2586 MOVE.L D1,BLOCK SET BADDATA ERROR * SOMETHING WENT WRONG SO TRY TO RESTART THE CURRENT REQUEST R2240 MOVE.B #CLEAR_INT,(COMMANDP) CLEAR INTERUPT REQUEST R2280 BTST #INT_R,INT_REG(CARDP) WAIT FOR IT TO GO AWAY BNE.S R2280 SUBQ.L #1,BRETRY(INFOP)SIZE(INFOP) MOVE.L CARDP,-(SP) CARD^ MOVE.L INFOP,-(SP) INFO^ MOVE.L #$21,-(SP) JSR INITIALREGS MOVEA.L 12(A6),A1 MOVEA.L (A1),CARDP MOVE.B #READ_DATA,COMMAND(CARDP) BRA ISRDONE * IN B_WRITEING STATE ... HAVE DATA TO WR DECRIMENT RETRY COUNTER BLT.S R2334 MOVE.L 12(A6),-(SP) CARD MOVE.L 8(A6),-(SP) INFO JSR STARTREAD RESTART THE CURRENT REQUEST BRA ISRDONE * TOO MANY RETRIES R2334 CLR.W RUNSTATE(INFOP) SET RUNSTATE TO B_IDITE OR END OF OPERATION WRITING BTST #BUSY,(STATUSP) BEQ.S R2716 * NORMAL WRITE OPERATION MOVE.L BUFEND(INFOP),D0 GET END OF BUFFER ADDRESS R2664 CMP.L BUFFP,D0 CHECK BUFFER AGAINST BUFFER END BEQ.S LE TST.W ERRORCODE(INFOP) IS ERRORCODE ALREADY SET ? BNE ISRDONE MOVE.W #BIOFAIL,ERRORCODE(INFOP) BRA ISRDONE * OPERATION COMPLETED OK * READ ANY DATA LEFT IN THE FIFO R2348 MOVE.L BUFEND(INFOP),D0 GET END OF B R2712 BTST #FIFO_AVAIL,(STATUSP) CHECK THE FIFO BEQ.S R2712 MOVE.B (BUFFP)+,(DATAP) WRITE THE DATA NOP FIX FOR 68020 BAR 7/11/85 NOP FIX FOR 68020 BAR 7/11/85 BRA.S R2664 UFFER ADDRESS R2350 CMP.L BUFFP,D0 CHECK BUFFER ADDRESS AGAINST END OF BUFFER BEQ.S R2412 BTST #FIFO_AVAIL,(STATUSP) CHECK THE FIFO BEQ.S R2440 MOVE.B (DATAP),(BUFFP)+ BRA.S R2350 * DISCARD THE REST OF THE DATA R24R2712 MOVE.L BUFFP,BUFADDR(INFOP) PUT BACK THE BUFFER ADDRESS BRA ISRDONE * NOT BUSY SO OPERATION IS DONE * DID ANYTHING GO WRONG? R2716 BTST #TIME_ERR,(STATUSP) BNE.S R2750 BTST #OP_FAIL,(STATUSP) BEQ.S      E * NO ERRORS SO FINISH UP R2820 MOVE.B #CLEAR_INT,(COMMANDP) CLEAR THE INTERUPT R2830 BTST #INT_R,INT_REG(CARDP) WAIT FOR IT TO GO AWAY BNE.S R2830 MOVE.L BBUFFER(INFOP),D0 CALCULATE END OF BUFFER ADDRESS ADDRIGHTS LEGEND Use, duplication, or disclosure by the Government is subject to restrictions as set forth in paragraph (b) (3) (B) of the Rights in Technical Data and Computer Software clause in DAR 7-104.9(a). HEWLETT-PACKARD COMPANY Fort Collins, Colorad.L BCOUNT(INFOP),D0 CMP.L BUFFP,D0 ANY MORE TO BE WRITTEN ? BEQ.S R3008 MOVE.L BLOCKSIZE(INFOP),D0 INCREMENT START PAGE ADD.L D0,BSPAGE(INFOP) MOVE.L BUFADDR(INFOP),D0 MOVE.L D0,BUFSTART(INFOP) SET NEW BUFFER ADDRESS MOVEo *) $SYSPROG$ $DEBUG OFF$$RANGE OFF$ $ALLOW_PACKED ON$ {JWS 3/31/87} program bubbles; module bubble; $SEARCH 'BUB_DVR'$ import bub_dvr,sysglobals,iodeclarations,isr; export procedure bub_tm(fp:fibp; request:amreques.L D0,BUFEND(INFOP) SAVE BASE FOR BUFEND * CALCULATE BLOCKSIZE FOR THIS OPERATION SUB.L BBUFFER(INFOP),D0 MOVE.L BCOUNT(INFOP),D1 SUB.L D0,D1 D1 NOW IS BYTES LEFT * PAGE IS ASSUMttype; anyvar buffer : window; bufsize, position : integer); procedure bub_isr(isrib : pisrib); procedure bub_init; IMPLEMENT procedure xlate_errors(error : berrortype); begin case error of bnoerror : ioresult := ord(inED TO HAVE 64 BYTES R2926 ASR.L #6,D1 DIVIDE BY 64 D1 NOW IS PAGES LEFT CMPI.L #MAXPAGES,D1 CLIP PAGES AT MAXPAGES BLT.S R2962 MOVE.L #MAXPAGES,D1 R2962 MOVE.L D1,BLOCKSIZE(INFOP) * FOR WRITE OPS, BUFEND oerror); btimeout : ioresult := ord(zbadhardware); bopfailed : ioresult := ord(zbadhardware); bbadinterupt:ioresult := ord(zstrangei); bbadsector : ioresult := ord(znosuchblk); bbadcount : ioresult := ord(zbadmode); bnotbubble : ioresult := ord(zIS END OF SEGMENT * RE-CALCULATE END OF BUFFER ASL.L #6,D1 CONVERT BLOCKSIZE TO BYTES (MULTIPLY BY 64) ADD.L D1,BUFEND(INFOP) ADD IT TO BASE MOVE.L CARDP,-(SP) CARD^ MOVE.L INFOP,-(SP) INFO^nodevice); bbaddata : ioresult := ord(zbadblock); biofail : ioresult := ord(ztimeout); otherwise ioresult := ord(zcatchall); end; end; procedure bub_tm(fp:fibp; request:amrequesttype; anyvar buffer : window; bufsize, po MOVE.L #$21,-(SP) JSR INITIALREGS MOVEA.L 12(A6),A1 MOVEA.L (A1),CARDP MOVE.B #WRITE_DATA,COMMAND(CARDP) BRA.S ISRDONE R3008 CLR.W RUNSTATE(INFOP) SET RUNSTATE TO B_IDLE ISRDONE UNLK A6 MOVEA.L (SP)+,A0 ADDQ.W #8,SP JMP (A0) sition : integer); var card : anyptr; info : infoptr; begin ioresult := ord(inoerror); with fp^ , unitable^[funit] do begin card := isc_table[sc].card_ptr; if isc_table[sc].io_tmp_ptr=NIL then ioresult := ord(znodev BUB_DVR_BUB_DVR EQU * RTS ice) else begin info := addr(isc_table[sc].io_tmp_ptr^.drv_misc); with info^ do case request of startread, readbytes: if runstate<>b_idle then ioresult := ord(znotready) else begin if (position+bufsize)<=fpeof then  (* (c) Copyright Hewlett-Packard Company, 1983. All rights are reserved. Copying or other reproduction of this program except for archival purposes is prohibited without the prior written consent of Hewlett-Packard Company. RESTRICTED  begin { is inside the file } bbuffer.brec := addr(buffer); bstart := fileid + byteoffset + position; bcount := bufsize; bretry := 3; if bcount<>0 then bubdoread(card,info); if request=rea      end; { bub_isr } procedure bub_init; const intreg = 3; { interupt reg offset } type cardrec = packed record pad : byte; id : byte; end; var sc : integer; isrinfo : pisrib; info :HPTR); 2 :(WPTR:WINDOWP); 3 :(CPTR:^CHAR); END; VAR SCANPTR : SCANREC; COUNTER : INTEGER; DONE : BOOLEAN; SIZE : INTEGER; BEGIN IORESULT := ORD(INOERROR); IF (UNITABLE^[FP^.FUNIT].BYTEOFFSET=0) AND : infoptr; card : ^cardrec; begin { scan selectcode table for bubble devices } for sc:= iominisc to iomaxisc do with isc_table[sc] do begin { fix isc_table to work for system 2.0, 2.1 or 2.2 } if ((card_type=1) a (REQUEST<>CLEARUNIT) THEN IORESULT:=ORD(ZNODEVICE) ELSE CASE REQUEST OF READBYTES: { MOVE DATA FROM EPROM TO BUFFER } IF BUFSIZE>0 THEN WITH FP^ DO BEGIN IF (POSITION+BUFSIZE)>FPEOF THEN IORESULT := ORD(ZNOSUCHBLK) ELdbytes then while runstate<>b_idle do; { wait for idle } if runstate=b_idle then xlate_errors(errorcode); end else ioresult := ord(ieof); end; startwrite, writebytes: if runstate<>b_idle then ioresult := ord(znond (card_id=0)) or ((card_type=8) and (card_id=30)) then begin card := card_ptr; if card^.id=30 then begin card_type := 8; { bubble memory card } card_id := 30; isrinfo := addr(io_tmp_ptr^); info := addr(io_tmp_ptrtready) else begin if (position+bufsize)<=fpeof then begin bbuffer.brec := addr(buffer); bstart := fileid + byteoffset + position; if bufsize>0 then bcount := (bufsize + 255) DIV 256 * 256 ^.drv_misc); bubgetinfo(card,info); if info^.errorcode=bnoerror then begin permisrlink(bub_isr, { ISR PROC } addr(card^,intreg), { INTERUPT REG ADDRESS } hex('C0'),hex('C0'),{ MASK and VALUE } info^.prio else bcount := bufsize; bretry := 3; if bcount<>0 then bubdowrite(card,info); if request=writebytes then while runstate<>b_idle do; { wait for idle } if runstate=b_idle then xlate_errors(errorcode); end rity, { INTERUPT PRIORITY } isrinfo); { ISR INFO POINTER } end; end; end; end; end; {bub_init} end; { bub_ops } { bubbles installation program } import bubble,loader; begin bub_init; markuser; end.  else ioresult := ord(ieof); end; flush:; { NO_OP } clearunit: begin bubdoreset(card,info); xlate_errors(info^.errorcode); if ioresult=ord(inoerror) then umaxbytes := maxbytes { set device size } $SYSPROG$ $DEBUG OFF$ $RANGE OFF$ $ALLOW_PACKED ON$ {JWS 3/31/87} PROGRAM INST_EPROM; MODULE EPROMS; IMPORT SYSGLOBALS,ASM; EXPORT PROCEDURE EPROM_TM(FP:FIBP; REQUEST:AMREQUESTTYPE; ANYVAR BUFFER:WINDOW; BUFSIZE,POSITION: INTEGER); IMPLEMENT  else umaxbytes := 0; end; unitstatus: begin fbusy := runstate<>b_idle; if not fbusy then xlate_errors(errorcode); end; otherwise ioresult := ord(ibadrequest); end; { case } end; { if nounit } end;  PROCEDURE EPROM_TM(FP:FIBP; REQUEST:AMREQUESTTYPE; ANYVAR BUFFER:WINDOW; BUFSIZE,POSITION: INTEGER); CONST LO_ROM = HEX('20000'); HI_ROM = HEX('200000'); STEPSIZE = HEX('4000'); ROMHEADER= HEX('F0FF'); HEADERSIZE = 18; K128 = { with } end; { bub_tm } $DEBUG OFF$ procedure bub_isr(isrib : pisrib); var temps : pio_tmp_ptr; info : infoptr; begin temps := addr(isrib^); info := addr(temps^.drv_misc); bubdoisr(temps^.card_addr,info);  131072; K256 = 262144; K16 = 16384; TYPE HRECORD = PACKED RECORD HEADER : 0..65535; IDCHAR : BYTE; FLAG : BYTE; END; HPTR = ^HRECORD; SCANREC = RECORD CASE INTEGER OF 0 :(INT:INTEGER); 1 :(PTR      SE BEGIN COUNTER := HEADERSIZE + FILEID + POSITION; COUNTER := COUNTER+(2*(COUNTER DIV K16))+ UNITABLE^[FUNIT].BYTEOFFSET; SCANPTR.INT := COUNTER; IF BUFSIZE=1 THEN BUFFER[0] := SCANPTR.CPTR^ ELSE BEGIN { MOVEING M (* (c) Copyright Hewlett-Packard Company, 1983. All rights are reserved. Copying or other reproduction of this program except for archival purposes is prohibited without the prior written consent of Hewlett-ORE THAN ONE BYTE OF DATA } COUNTER := 0; REPEAT SIZE := (SCANPTR.INT + K16) DIV K16 * K16 - SCANPTR.INT; IF SIZE>BUFSIZE THEN SIZE := BUFSIZE; MOVELEFT(SCANPTR.CPTR^,BUFFER[COUNTER],SIZE); BUFSIZE := BUFSIZE - SIZE; COUNTER := COUNPackard Company. RESTRICTED RIGHTS LEGEND Use, duplication, or disclosure by the Government is subject to restrictions as set forth in paragraph (b) (3) (B) of the Rights in Technical Data and Computer Software clause in DAR 7-104.9(a). HEWTER + SIZE; SCANPTR.INT := SCANPTR.INT + SIZE + 2; UNTIL BUFSIZE=0; END; END; END; { READBYTES } WRITEBYTES: IORESULT := ORD(ZPROTECTED); FLUSH:; CLEARUNIT: BEGIN { FIND THE nTH DISC HEADER } SCANPTR.INT := LETT-PACKARD COMPANY Fort Collins, Colorado *) $modcal$ $debug off, range off, ovflcheck off$ $stackcheck off, iocheck off$ $search 'GPIODVR' { , 'IOLIB:COMASM', 'IOLIB:KERNEL'} $ $page$ $copyright 'COPYRIGHT (C) 1983 BY HEWLETLO_ROM; UNITABLE^[FP^.FUNIT].BYTEOFFSET := 0; { CLEAR THE OFFSET } COUNTER := UNITABLE^[FP^.FUNIT].DV; DONE := FALSE; REPEAT { FIND THE EPROM DISC HEADER } TRY IF SCANPTR.PTR^.HEADER=ROMHEADER THEN BEGIN IF (SCANPTR.PTR^.FT-PACKARD COMPANY'$ program F9885init; module F9885dvr; import sysglobals, mini, gp, iodeclarations, iocomasm, misc; export procedure F9885io (fp: fibp; request: amrequesttype; anyvar buffer: window; length, position: integer)LAG=HEX('08')) OR (SCANPTR.PTR^.FLAG=HEX('18')) THEN BEGIN { FOUND DISC HEADER } COUNTER := COUNTER - 1; { COUNT IT } DONE := COUNTER<0; { IS THIS THE ONE } END; END; IF NOT DONE THEN SCANPTR.INT := SCANPTR.INT + STE; implement procedure F9885io; type errors = (noerror, nopower, dooropen, nodisc, badcommand, norecord, notrack, badcheckword, dataoverrun, badverify); primarycommands = (readblock, verifyblock, writeblock, settracksector); PSIZE; RECOVER { IGNORE BUS ERRORS } IF ESCAPECODE<>-12 THEN ESCAPE(ESCAPECODE) ELSE SCANPTR.INT := SCANPTR.INT + STEPSIZE; DONE := DONE OR (SCANPTR.INT>=HI_ROM); UNTIL DONE; IF SCANPTR.INT>=HI_ROM THEN IORESULT := OR fd = {floppy disc command & status structure} packed record case integer of -1: (w: shortint); 0: (case primary: primarycommands of readblock, verifyblock, writeblock: (drv: 0..3; nrecords: 0..4095); D(ZNODEVICE) ELSE WITH UNITABLE^[FP^.FUNIT] DO BEGIN BYTEOFFSET := SCANPTR.INT; UMAXBYTES := (SCANPTR.INT+K256) DIV K256 * K256 - SCANPTR.INT; END; END; { CLEARUNIT } OTHERWISE IORESULT := ORD(ZBADMODE);  settracksector: (driv: 0..3; track: 0..127; sector: 0..31)); 1: (pad: 0..15; errcode: errors; p2, transfercomplete, seekcomplete, notready, writeprotected, dooropened: boolean; drve: 0..3);  END; { CASE REQUEST } END; END; { MODULE EPROM_MODULE } { EPROMS INSTALLATION PROGRAM } IMPORT LOADER; BEGIN MARKUSER; END.  end; gpio_enable_type = packed array[0..1] of gpio_r3_type; const maxtries = 10; password = -20857; gpio_enable = {gpio enable bytes for the 2 DMA channels} gpio_enable_type [ gpio_r3_type [ Wenab: false,      sue request status command} gpiowordout(gptr^, 0); {clear output regs & request data word} status.w := gpiowordin(gptr^); {input status word} if (status.drve<>uep^.du) or (status.pad<>0) then clear_and_escape(-10, o then ioresult := ord(inoerror) else clear_and_escape(escapecode, ioresult); end; {recover} with gptr^ do begin r7 := 1; {set the end of transfer bit} rd(zcatchall)); if status.dooropened then begin uep^.umediavalid := false; if uep^.ureportchange then ioresc(zmediumchanged); end; {if} $page$ tries := 0; while total_words>0 do be Wdata := 0; {clear bidirectional buffer for reading status} setpctl := 0; {request the status word} status.w := gpiowordin(gptr^); {save the status word} r7 W3pad:0, Wword:true, Wdmac1:false, Wdmac0:true ], gpio_r3_type [ Wenab: false, W3pad:0, Wword:true, Wdmac1:true, Wdmac0:false ] ]; var uep: ^unitentry; gptr: ^gpiotype; tptr: pio_tmp_ptr; bufptr: charptr; $page$ pgin try gpiowordout(gptr^, password); opcode.primary := settracksector; opcode.driv := uep^.du; opcode.track := record_addr div 30; opcode.sector := record_addr mod 30; rocedure clear_unit; begin with gptr^ do if sti1 or sti0 then ioresc(znodevice); gpioclear(gptr^); {also tests psts while waiting for ready} end; procedure clear_and_escape(escape_value: shortint; iores_val gpiowordout(gptr^, opcode.w); repeat chan := dma_request(tptr); until chan>=0; if (chan<>0) and (chan<>1) then ioresc(zcatchall); if total_words<=65536 then words := total_wordsue: integer); begin {clear_and_escape} try gpioclear(gptr^); recover {do nothing}; ioresult := iores_value; escape(escape_value); end; {clear_and_escape} procedure transfer(record_addr, total_words: integ else words := 65536; sectors := (words+127) div 128; gpiowordout(gptr^, password); opcode.drv := uep^.du; opcode.nrecords:= sectors; case request of readbytes, startrer); var gpiodma_proc: procedure(var gpio: gpiotype; command: shortint; enable_byte: gpio_r3_type; var dma_channel: dmachanneltype; buffer: charptr; length:ead: begin opcode.primary := readblock; gpiodma_proc := gpiodmain; end; writebytes, startwrite: begin opcode.primary := writeblock;  integer); status, opcode: fd; chan, tries, sectors: shortint; words: integer; const request_status = fd [ primary: settracksector, driv: 0, track: 127, sector: 31 ]; begin {transfer} if not dma_here then iore gpiodma_proc := gpiodmaout; end; end; {case} call(gpiodma_proc, gptr^, opcode.w, gpio_enable[chan], dma_port[chan], bufptr, words); ioresc(inoerror); {invoke proper cleanup} recover sc(zbaddma); gptr^.r3 := 0; {setup gpio card} gptr^.r7 := 0; gpiowordout(gptr^, password); {issue password} opcode := request_status; opcode.driv := uep^.du; gpiowordout(gptr^, opcode.w); {is begin gptr^.r3 := 0; {disable the gpio card} dma_release(tptr); {release the dma resource} if (escapecode=-10) and ( (ioresult=ord(inoerror)) or (ioresult= ord(zcatchall)) )        := 0; {clear the end of transfer bit} end; {with} $page$ if (status.drve<>uep^.du) or (status.pad<>0) then clear_and_escape(-10, ord(zcatchall)); with status do case errcod case request of clearunit: clear_unit; unitstatus: fp^.fbusy := false; flush: {do nothing}; readbytes, writebytes, startread, startwrite: begine of noerror: begin if notready or (not seekcomplete) or (not transfercomplete) then clear_and_escape(-10, ord(zcatchall)); tries := 0; record_add if uep^.ureportchange and not uep^.umediavalid then ioresc(zmediumchanged); bufptr := addr(buffer); if (position mod 256<>0) or odd(integer(bufptr)) then ioresc(zbadmode);r := record_addr+sectors; total_words := total_words-words; bufptr := addr(bufptr^,words*2) end; nopower: ioresc(znodevice); dooropen, nodisc:  if (position<0) or (length<0) or (position+length>fp^.fpeof) then ioresc(ieof); transfer((position+fp^.fileid+uep^.byteoffset) div 256, (length+1) div 2); end; otherwise  ioresc(znomedium); badcommand: if writeprotected and ( (request=writebytes) or (request=startwrite) ) then ioresc(zprotected) else clear_and_escape(-10, ord(zcatchall));  ioresc(ibadrequest); end; {cases} ioresc(inoerror); {set ioresult & perform lockdown} recover begin lockdown; if escapecode<>-10 then escape(escapecode); if (request=startrea notrack: ioresc(znoblock); norecord, badcheckword: begin tries := tries+1; if tries>=maxtries then begin if errcode=norecord thend) or (request=startwrite) then call(fp^.feot, fp); end; {recover} end; {else} end; {f9885io} end; {f9885dvr} { program F9885init } import loader; begin {F9885init} markuser; end. {F9885init}  ioresc(znoblock); if errcode=badcheckword then ioresc(zbadblock); ioresc(zcatchall); end; {if} end; dataoverrun: ioresc(zbadhardware);  (* (c) Copyright Hewlett-Packard Company, 1984. All rights are reserved. Copying or other reproduction of this program except for archival purposes is prohibited without the prior written consent of Hewlett- otherwise clear_and_escape(-10, ord(zcatchall)); end; {case} end; {while} end; {transfer} $page$ begin {F9885io} uep := addr(unitable^[fp^.funit]); if uep^.offline then ioresult := ord(znodevice) Packard Company. RESTRICTED RIGHTS LEGEND Use, duplication, or disclosure by the Government is subject to restrictions as set forth in paragraph (b) (3) (B) of the Rights in Technical Data and Computer Software clause in DAR 7-104.9(a). HEW else begin lockup; try with isc_table[uep^.sc] do begin if card_id<>hp98622 then ioresc(znodevice); gptr := card_ptr; tptr := io_tmp_ptr; end; {with} LETT-PACKARD COMPANY Fort Collins, Colorado *) $modcal$ $debug off, range off, ovflcheck off$ $stackcheck off, iocheck off$ {{ $search 'KERNEL'$ {{ $search 'IOLIB:KERNEL','OSFS:SYSDEVS'$ {} $page$ $copyright 'COPYRIGHT (C) 1984       ure reset_card_and_confirm_timeout; var saved_escapecode: shortint; saved_ioe_sc: integer; saved_ioe_result: integer; begin {reset_card_and_confirm_timeout} saved_escapecode := escapecode; saved_ioe_sc := ioe_isc; saved_ioe_resuptr^.iod_wtc, io_tmp_ptr, 21, 0); {set the reset type to not present} call(io_drv_ptr^.iod_init, io_tmp_ptr); {reset driver} call(io_drv_ptr^.iod_rds, io_tmp_ptr, 20, w); {get peripheral type} if w = 1 then {OUTPUT_ONlt := ioe_result; try with sc_table_entry_ptr^ do call(io_drv_ptr^.iod_init, io_tmp_ptr); recover if (escapecode<>ioescapecode) or (ioe_isc<>select_code) then escape(escapecode); ioe_isc := saved_ioe_sc; ioe_resuLY} begin call(io_drv_ptr^.iod_wtc, io_tmp_ptr, 20, 11); {set current type to user_spec_output_only} call(io_drv_ptr^.iod_wtc, io_tmp_ptr, 21, 11); {set the reset type to same} end else {not a pBY HEWLETT-PACKARD COMPANY'$ module prtdvr; import sysglobals, iodeclarations, asm, sysdevs, mini, misc, fs; export procedure prtio (fp: fibp; request: amrequesttype; anyvar buffer: window; lenlt := saved_ioe_result; if (saved_escapecode<>ioescapecode) or (ioe_isc<>select_code) then escape(saved_escapecode); if ioe_result<>ioe_timeout then ioresc(znodevice); end; {reset_card_and_confirm_timeout} procedure clear_unit; var wgth, position: integer); implement {prtdvr} procedure bep; begin write(bellchar); end; procedure prtio(fp: fibp; request: amrequesttype; anyvar buffer: window; length, position: integer); const ucl:io_word; procedure HPIBsdc; begin {HPIBsdc} with sc_table_entry_ptr^, io_drv_ptr^, io_tmp_ptr^ do begin call(iod_send, io_tmp_ptr, '?'); timeout := uclr_timeout_const; call(iod_send, io_tmp_ptr, chr(LAGbasr_timeout_const = 25; {HPIB commands during unitclear} repeating_timeout = 333; {timeout constant after initial timeout} timeouts_per_beep = 40; {beep period in repeating timeout units} SDC = 4; {selective device clear}e+bus_address)); call(iod_send, io_tmp_ptr, chr(SDC)); end; {with} end; {HPIBsdc} begin {clear_unit} with sc_table_entry_ptr^ do if card_type=hpib_card then try HPIBsdc; {first attempt} re LAGbase = 32; {listen address group base} TAGbase = 64; {talk address group base} linefeed = chr(10); {ASCII linefeed} formfeed = chr(12); {ASCII formfeed} return = chr(13); {ASCII carriage return} var select_code: tcover begin reset_card_and_confirm_timeout; try HPIBsdc; {second attempt} recover begin reset_card_and_confirm_timeout; ioresc(ztimeout); ype_isc; sc_table_entry_ptr: ^isc_table_type; previous_char_ptr: charptr; bus_address: byte; channel_is_setup: boolean; writing_previous_char: boolean; previously_timed_out: boolean; timeout_blanked: boolean; user_spec_timeout: integer;  end; {recover} end {recover} else if card_type = serial_card then {12/89 dew - added pllel} try call(io_drv_ptr^.iod_init, io_tmp_ptr); recover if (escapecode<>ioescapecode) ocurrent_timeout: integer; timeout_counter: shortint; saved_line : string[42]; { 3.0 bug fix -- 4/12/84 } line_needs_restoring : boolean; { 4/12/84 } buf: charptr; saved_echo: boolean; { 5/9/84 } $page$ procedr (ioe_isc<>select_code) then escape(escapecode) else ioresc(znodevice) else {parallel_card} {12/89 dew - added pllel} try io_tmp_ptr^.timeout := current_timeout; call(io_drv_      rinter there} ioresc(znodevice); recover begin reset_card_and_confirm_timeout; ioresc(ztimeout); end; {recover} end; {clear_unit} $page$ procedure wrtchar(character: char; last_char: b previous_hs_completed := false; if not channel_is_setup then begin case card_type of hpib_card: begin call(iod_send, io_tmp_ptr, '?'); oolean); var hs_successfully_initiated: boolean; previous_hs_completed : boolean; procedure restore_line; var dummyc:char; begin if line_needs_restoring then { 4/12/84 } begin keybuffer^.echo:=saved_echo; keybufops previous_hs_completed := true; timeout := current_timeout; call(iod_send, io_tmp_ptr, chr(TAGbase+addressed)); call(iod_send, io_tmp_ptr, chr(LAGbase+bus_address)); (kdisplay,dummyc); line_needs_restoring:=false; end; end; $page$ procedure inform_operator; var lmstr : string[42]; { 3.0 bug fix -- 4/12/84 } begin {inform_operator} if not previously_timed_out then  end; {hpib_card} serial_card: if card_id=hp98626 then {always set full duplex modem HS} call(iod_wtc, io_tmp_ptr, 13, 1); pllel_card: { begin timeout_blanked := true; timeout_counter := 0; end; if not line_needs_restoring then begin saved_line := '* Printer timeout: fix or '; if intlevel=0 then saved_line:=saved_line+' aborts *' 12/89 dew - added pllel} begin timeout := current_timeout; call(iod_wtc, io_tmp_ptr, 24, 4); {write verify} end; otherwise {do nothing else saved_line:=saved_line+'wait auto-abort*' ; { 3.0 bug fix -- 4/12/84 } line_needs_restoring := true; if menustate=m_none then saved_echo:=keybuffer^.echo }; end; {case} channel_is_setup := true; end; {if} call(iod_wtb, io_tmp_ptr, character); previous_char_ptr^ := character; timeout := current_timeout; if last_char else saved_echo:=true; menustate := m_none; { 4/12/84 } keybuffer^.echo :=false; end; if timeout_blanked then lmstr:= saved_line else lmstr:= ' '; CALL(CRTLLHOOK,CLLDISPLAY,LMSTR,' ');  then if card_type=hpib_card then call(iod_send, io_tmp_ptr, '?'); if previously_timed_out then if not writing_previous_char then begin restore_line;  timeout_blanked:= (timeout_counter mod 4)<>0; if timeout_counter<=1 then bep; timeout_counter := timeout_counter+1; if timeout_counter>=timeouts_per_beep then if intlevel=0 then timeout_counter := 0 else b current_timeout := user_spec_timeout; previously_timed_out := false; end; {if} hs_successfully_initiated := true; recover begin reset_card_and_confirm_timeout; egin bep; restore_line; ioresc(ztimeout); end; {else} end; {inform_operator} $page$ begin {wrtchar} try with sc_table_entry_ptr^, io_drv_ptr^, io_tmp_ptr^ do repeat try  channel_is_setup := false; inform_operator; previously_timed_out := true; current_timeout := repeating_timeout; if not (writing_previous_char or previous_hs_completed) then begin        wrtchar(buf^, length=1); buf := addr(buf^, 1); length := length-1; end; otherwise ioresc(zbadmode); end; {case} recover if (escapecode=-20) and previously_timed_out then  } verify_cmd, { verify } unbuf_write_cmd, { unbuffered write } init_d_cmd, { initialize, setting D bits } format_cmd, { format } buf_read_cm ioresult := ord(ztimeout) else if escapecode<>-10 then escape(escapecode); end; {prtio} end. {prtdvr} d, { buffered read } buf_write_cmd ); { buffered write } ftcb_type = {first two command bytes - structure for most commands} packed record opcode: byte; unit: byte; end; s1_type = writing_previous_char := true; wrtchar(previous_char_ptr^, false); writing_previous_char := false; end; {if} hs_successfully_initiated := false; end; {recover}  (* (c) Copyright Hewlett-Packard Company, 1983. All rights are reserved. Copying or other reproduction of this program except for archival purposes is prohibited without the prior written consent of Hewlett- until hs_successfully_initiated; recover begin restore_line; { 4/12/84 } escape(escapecode); end; {recover} end; {wrtchar} $page$ begin {prtio} ioresult := ord(inoerror); { scPackard Company. RESTRICTED RIGHTS LEGEND Use, duplication, or disclosure by the Government is subject to restrictions as set forth in paragraph (b) (3) (B) of the Rights in Technical Data and Computer Software clause in DAR 7-104.9(a). HEWs 1/17/83 } with unitable^[fp^.funit] do begin select_code := sc; sc_table_entry_ptr := addr(isc_table[select_code]); bus_address := ba; previous_char_ptr := addr(dvrtemp); user_spec_timeout := devid; {useLETT-PACKARD COMPANY Fort Collins, Colorado *) $modcal$ $debug off, range off, ovflcheck off$ $stackcheck off, iocheck off$ $ALLOW_PACKED ON$ { JWS 4/10/85 } $search 'DRVASM', 'DISCHPIB' {, 'IOLIB:KERNEL' } $ $page$ $copyrightr-specified in CTABLE} end; {with} buf := addr(buffer); channel_is_setup := false; current_timeout := user_spec_timeout; previously_timed_out := false; writing_previous_char := false; line_needs_restoring := false; { 4/12/8 'COPYRIGHT (C) 1983 BY HEWLETT-PACKARD COMPANY'$ program AMIGOinit; module CSamigo; {amigo command set} import sysglobals, bkgnd, discHPIB; export type amigo_dev_type = {enumerated supported amigo devices} (HP9895, HP8290X, HP913X_A,4 } try with sc_table_entry_ptr^, io_tmp_ptr^ do begin if card_type=no_card then ioresc(znodevice); while (in_bufptr<>nil) or (out_bufptr<>nil) do {nothing}; end; {with} case request of flush:  HP913X_B, HP913X_C, HP7905, HP7906, HP7920, HP7925); command_type = {commands supported by the issue_cmd procedure} ( req_status, { request status } req_syndrome, { request syndrome } req_log_addr {do nothing}; clearunit: clear_unit; writeeol: begin wrtchar(return, false); wrtchar(linefeed, true) end; writebytes: while length>0 do begin , { request logical address } seek_cmd, { seek } addr_record_cmd, { address record } recalibrate_cmd, { recalibrate } unbuf_read_cmd, { unbuffered read        {enumerated status 1 values} ( normal_completion , illegal_opcode , unit_available , illegal_drive_type , s1_4 , s1_5  conditions *'ed below } xx: 0..3; { 14-13 undefined } tttt: 0..15; { 12-9 disc type bits } r: boolean; { 8 reserved } a: boolean; { 7 drive a , s1_6 , cylinder_compare_error , uncorrectable_data_error , head_sector_compare_error , io_program_error , s1_11 ttention } w: boolean; { 6 write protected } fmt: boolean; { 5 format switch } e: boolean; { 4 *drive fault } f: boolean; { 3 first status bit  , end_of_cylinder , sync_bit_not_received_in_time , overrun , possibly_correctable_data_error , illegal_access_to_spare_track , defective_track  } c: boolean; { 2 *seek check } ss: 0..3; { 1,0 *drive ready status } end; syndrome_type = {14 bytes of returned syndrome information} packed record sb_pad1: 0..7; s , access_not_ready_during_data_operation , status_2_error , s1_20 , s1_21 , attempt_to_write_on_protected_track , unit_unavailable , sb_s1: s1_type; sb_pad2: byte; sb_tva: tva_type; sb_offset: shortint; sb_correction_bytes: packed array[0..5] of char; end; map_type = {media addressing parameters} record cyl_per_med: shortint; { nu1_24 , s1_25 , s1_26 , s1_27 , s1_28 , s1_29 , s1_30 mber of cylinders per medium } trk_per_cyl: shortint; { number of tracks per cylinder } sec_per_trk: shortint; { number of sectors per track } end; unsigned16 = 0..65535; $page$ function device (uep: ue , drive_attention ); $page$ tva_type = {three vector address} packed record cyl: shortint; { cylinder address } head: byte; { head address } sect: byte; { sector addresp_type): amigo_dev_type; function MI_controller (uep: uep_type): boolean; function surface_mode (uep: uep_type): boolean; procedure get_map (uep: uep_type; var map: map_type); function records_per_medium (uep: uep_type): ins } end; status_type = {4 bytes of returned status} packed record { stat 1 - from previous operation } s: boolean; { 15 spare track bit } p: boolean; { 14 protected track bit } teger; function decoded_addr (uep: uep_type; tva: tva_type): integer; procedure issue_cmd (uep: uep_type; command: command_type; var cmd_buffer: ftcb_type); function dsj (uep: uep_type): byte; procedure set_file_mas d: boolean; { 13 defective track bit } s1: s1_type; { 12-8 last operation status } unit: byte; { 7-0 unit number } { stat 2 - from specified drive } star: boolean; { 15 k (uep: uep_type); procedure recalibrate (uep: uep_type); procedure status (uep: uep_type; var status_bytes: status_type); procedure syndrome (uep: uep_type; var syndrome_bytes: syndrome_type); procedure seek       med: 152, trk_per_cyl: 4, sec_per_trk: 31], {HP913X_B} map_type[ cyl_per_med: 305, trk_per_cyl: 4, sec_per_trk: 31], {HP913X_C} map_type[ cyl_per_med: 305, trk_per_cyl: 6, sec_per_trk: 31], {HP7905} map_type[ cyl_per_med: 400, tr], {addr_record_cmd} ctet[sec: 8, oc: 12, nb: 6], {recalibrate_cmd} ctet[sec: 8, oc: 01, nb: 2], {unbuf_read_cmd } ctet[sec: 8, oc: 05, nb: 2], {verify_cmd } ctet[sec: 8, oc: 07, nb: 4], {unbuf_write_cmd}k_per_cyl: 2, sec_per_trk: 48], {HP7906} map_type[ cyl_per_med: 400, trk_per_cyl: 2, sec_per_trk: 48], {HP7920} map_type[ cyl_per_med: 800, trk_per_cyl: 5, sec_per_trk: 48], {HP7925} map_type[ cyl_per_med: 800, trk_per_cyl: 9, ctet[sec: 8, oc: 08, nb: 2], {init_d_cmd } ctet[sec: 8, oc: 43, nb: 2], {format_cmd } ctet[sec: 12, oc: 24, nb: 5], {buf_read_cmd } ctet[sec: 10, oc: 05, nb: 2], {buf_write_cmd } ctet[sec: 9, oc: 08, nb:  (uep: uep_type; record_addr: integer); procedure addr_record (uep: uep_type; record_addr: integer); function logical_addr (uep: uep_type): integer; implement {CSamigo} var most_recent_status: status_type; {for post-mortem di sec_per_trk: 64] ]; var this_device: amigo_dev_type; begin {get_map} this_device := device(uep); if this_device=HP9895 then {use single/double-sided flag set by status routine} case uep^.devid of 1: map := SS9895_map; agnostic purposes only!!!} function device(uep: uep_type): amigo_dev_type; begin {device} case uep^.letter of 'H': device := HP9895; 'N': device := HP8290X; 'U': device := HP913X_A; 'V': device := HP9 2: map := DS9895_map; otherwise ioresc_bkgnd(uep, zcatchall); end {case} else map := device_maps[this_device]; end; {get_map} function records_per_medium(uep: uep_type): integer; var map: map_type; begin {records_per_13X_B; 'W': device := HP913X_C; 'Y': device := HP7905; 'C': device := HP7906; 'P': device := HP7920; 'X': device := HP7925; otherwise ioresc_bkgnd(uep, znodevice); end {case} end; {demedium} get_map(uep, map); with map do records_per_medium := sec_per_trk*trk_per_cyl*cyl_per_med; end; {records_per_medium} function dsj(uep: uep_type): byte; var dsj_byte: packed record b: byte; end; const dsj_sec = 16; bvice} function MI_controller(uep: uep_type): boolean; begin {MI_controller} MI_controller := device(uep) in [HP7905, HP7906, HP7920, HP7925]; end; {MI_controller} function surface_mode(uep: uep_type): boolean; begin {surface_mode} surfaceegin {dsj} HPIBshort_msge_in(uep, dsj_sec, addr(dsj_byte), sizeof(dsj_byte)); dsj := dsj_byte.b; end; {dsj} $page$ procedure issue_cmd(uep: uep_type; command: command_type; var cmd_buffer: ftcb_type); type ctet = {command table entry type}_mode := device(uep) in [HP7905, HP7906]; end; {surface_mode} $page$ procedure get_map(uep: uep_type; var map: map_type); type device_maps_type = array[HP8290X..HP7925] of map_type; const DS9895_map = map_type[ cyl_per_med: 75, trk_per_cyl packed record sec: shortint; { secondary command } oc: byte; { opcode } nb: byte; { number of data bytes } end; command_table_type = packed array[command_type] of ctet; const comm: 2, sec_per_trk: 30]; SS9895_map = map_type[ cyl_per_med: 73, trk_per_cyl: 1, sec_per_trk: 30]; device_maps = device_maps_type [{HP8290X} map_type[ cyl_per_med: 33, trk_per_cyl: 2, sec_per_trk: 16], {HP913X_A} map_type[ cyl_per_and_table = command_table_type [ {req_status } ctet[sec: 8, oc: 03, nb: 2], {req_syndrome } ctet[sec: 8, oc: 13, nb: 2], {req_log_addr } ctet[sec: 8, oc: 20, nb: 2], {seek_cmd } ctet[sec: 8, oc: 02, nb: 6      2] ]; begin {issue_cmd} with cmd_buffer, command_table[command] do begin opcode := oc; unit := uep^.du; HPIBshort_msge_out(uep, sec, addr(cmd_buffer), nb); end; {with} end; {issue_cmd} procedure set_file_mask(var syndrome_bytes: syndrome_type); var syndrome_cmd_buf: ftcb_type; const send_syn_sec = 8; begin {syndrome} issue_cmd(uep, req_syndrome, syndrome_cmd_buf); HPIBshort_msge_in(uep, send_syn_sec, addr(syndrome_bytes), sizeof(syndrome_buep: uep_type); type sfm_cmd_type = {set file mask command} packed record oc: byte; mask: byte; end; sfm_cmd_array_type = array[boolean] of sfm_cmd_type; const sfm_sec = 8; {secondary} sfm_oc = 15; ytes)); end; {syndrome} $page$ function coded_addr(uep: uep_type; record_addr: integer): tva_type; var map: map_type; track: integer; begin {coded_addr} get_map(uep, map); with map do begin coded_addr.sect := record_ad {op code} sfm_cmd_array = sfm_cmd_array_type [ {false: cylinder mode} sfm_cmd_type[ oc: sfm_oc, mask: 7 ], {true: surface mode } sfm_cmd_type[ oc: sfm_oc, mask: 5 ] ]; var sfm_cmd: sfm_cmd_type; begin {set_file_mask} sfdr mod sec_per_trk; track := record_addr div sec_per_trk; if surface_mode(uep) then begin {select proper 7905/06 logical "volume"} coded_addr.head := track div cyl_per_med + 2*uep^.dv; coded_addm_cmd := sfm_cmd_array[surface_mode(uep)]; HPIBshort_msge_out(uep, sfm_sec, addr(sfm_cmd), sizeof(sfm_cmd)); end; {set_file_mask} $page$ procedure recalibrate(uep: uep_type); var recalibrate_cmd_buf: ftcb_type; begin {recalibrate} issue_r.cyl := track mod cyl_per_med; end {then} else begin coded_addr.head := track mod trk_per_cyl; coded_addr.cyl := track div trk_per_cyl; end; {else} end; {with} end; {coded_addr} funcmd(uep, recalibrate_cmd, recalibrate_cmd_buf); end; {recalibrate} procedure status(uep: uep_type; var status_bytes: status_type); var status_cmd_buf: ftcb_type; const send_sts_sec = 8; begin {status} issue_cmd(uep, req_status, statusction decoded_addr(uep: uep_type; tva: tva_type): integer; var map: map_type; track: integer; begin {decoded_addr} get_map(uep, map); with tva, map do begin if surface_mode(uep) then track := (head-2*uep^.dv)*cyl_cmd_buf); if not MI_controller(uep) then HPIBwait_for_ppol(uep); HPIBshort_msge_in(uep, send_sts_sec, addr(status_bytes), sizeof(status_bytes)); most_recent_status := status_bytes; {for post-mortem diagnostic purposes only!} with uep^ do _per_med+cyl else track := cyl*trk_per_cyl+head; decoded_addr := track*sec_per_trk+sect; end; {with} end; {decoded_addr} $page$ procedure seek(uep: uep_type; record_addr: integer); var seek_cmd_buf: packed record  case device(uep) of HP9895: {use the otherwise undefined devid field to indicate...} if status_bytes.tttt in [5,6] then devid := 2 {double-sided disc} else devid := 1; {single-sided disc}  ftcb: ftcb_type; tva: tva_type; end; begin {seek} seek_cmd_buf.tva := coded_addr(uep, record_addr); issue_cmd(uep, seek_cmd, seek_cmd_buf.ftcb); end; {seek} procedure addr_record(uep: uep_type; record_addr: integer); var  HP8290X: {use the otherwise undefined devid field to indicate...} devid := ord(status_bytes.r); {Sparrow (1) versus Chinook (0)} otherwise {do nothing}; end; {case} end; {status} procedure syndrome(uep: uep_type;  addr_record_cmd_buf: packed record ftcb: ftcb_type; tva: tva_type; end; begin {addr_record} addr_record_cmd_buf.tva := coded_addr(uep, record_addr); issue_cmd(uep, addr_record_cmd, addr_record_cmd_buf.ftcb); end;       ent: 1*256+ 10 {$010A}, letter: 'V' ], {HP913X_C} itet[ ident: 1*256+ 15 {$010F}, letter: 'W' ], {MAC} itet[ ident: 0*256+ 2 {$0002}, letter: 'X' ], {IDC} itet[ ident: 0*256+ 3 {$0003}, letter: 'X' ] ]; begin {get_limon_DMA(uep))) then ioresc_bkgnd(uep, znodevice); end {then} else {require EXACT device/ident match} if ident<>device_ident[dev] then ioresc_bkgnd(uep, znodevice); if dev=HP8290X then {avoid the amigo clear; it takes too mucetter} letter := chr(255); {initially undefined} for index := 1 to ident_table_entries do if ident=ident_table[index].ident then letter := ident_table[index].letter; if letter=chr(255) then ioresc_bkgnd(uep, znodevice); uep^h time!} dummy_dsj := dsj(uep) {just remove the power-on holdoff} else {go ahead and do the hard clear} begin HPIBamigo_clear(uep); HPIBwait_for_ppol(uep); end; {else} status(uep, status_bytes); if dsj(uep)<>{addr_record} function logical_addr(uep: uep_type): integer; var ladd_cmd_buf: ftcb_type; tva: tva_type; const send_addr_sec = 8; begin {logical_addr} issue_cmd(uep, req_log_addr, ladd_cmd_buf); if not MI_controller(uep) then HP.letter := letter; {for determining ppol wait in status routine} if dsj(uep)<>0 then {don't worry about it}; HPIBamigo_clear(uep); HPIBwait_for_ppol(uep); status(uep, status_bytes); if dsj(uep)<>0 then ioresc_bkgnd(uep, zcatchall); IBwait_for_ppol(uep); HPIBshort_msge_in(uep, send_addr_sec, addr(tva), sizeof(tva)); logical_addr := decoded_addr(uep, tva); end; {logical_addr} end; {CSamigo} $page$ module amigodvr; import sysglobals, drvasm, bkgnd, discHPIB, CSamigo; ex if status_bytes.ss=2 then ioresc_bkgnd(uep, znodevice); {"unit not present or power off"} if letter='X' then {determine which 7906 family member it really is} begin if not (status_bytes.tttt in [0..3]) then ioresc_bkgnd(uep,port procedure get_letter(uep: uep_type; ident: shortint; var letter: char); procedure amigoio(fp: fibp; request: amrequesttype; anyvar buffer: window; length, position: integer); implement {amigodvr} { procedure used by CTABL znodevice); {unrecognized unit type} letter := device_table[status_bytes.tttt]; end; {if} end; {get_letter} procedure clear_unit(uep:uep_type); type device_ident_type = array[HP9895..HP913X_C] of shortint; device_table_type = E for self-configuring } procedure get_letter(uep: uep_type; ident: shortint; var letter: char); const ident_table_entries = 7; var index: shortint; status_bytes: status_type; type device_table_type = array[0..3] of char; itet = {array[0..3] of amigo_dev_type; const device_ident = device_ident_type [ {HP9895 } 0*256+129, {$0081} {HP8290X} 1*256+ 4, {$0104} {HP913X_A} 1*256+ 6, {$0106} {HP913X_B} 1*256+ 10, {$010A} {HP913X_C} ident_table_entry_type} record ident: shortint; letter: char; end; ident_table_type = array[1..ident_table_entries] of itet; const device_table = device_table_type [ {0} 'C', {1} 'P', {2} 'Y', {3} 'X' ]; iden1*256+ 15 {$010F} ]; MAC_ident = 0*256+2; {$0002} IDC_ident = 0*256+3; {$0003} device_table = device_table_type [ {0} HP7906, {1} HP7920, {2} HP7905, {3} HP7925 ]; var dev: amigo_dev_type; ident: shortint; dummy_dsj: bytt_table = ident_table_type [ {HP9895 } itet[ ident: 0*256+129 {$0081}, letter: 'H' ], {HP8290X} itet[ ident: 1*256+ 4 {$0104}, letter: 'N' ], {HP913X_A} itet[ ident: 1*256+ 6 {$0106}, letter: 'U' ], {HP913X_B} itet[ ide; status_bytes: status_type; begin {clear_unit} dev := device(uep); ident := HPIBamigo_identify(uep); if MI_controller(uep) then {check for MAC or IDC controller} begin if not ((ident=MAC_ident) or ((ident=IDC_ident) and S     0 then ioresc_bkgnd(uep, zcatchall); if status_bytes.ss=2 then ioresc_bkgnd(uep, znodevice); {"unit not present or power off"} if MI_controller(uep) then {we need to check the exact type of THIS particular unit} begin if not (sta begin feot := fp^.feot; {end of transfer procedure} fibptr := fp; {parmeter to the eot procedure} async := asynchronous; {determines whether or not to call eot proc} tus_bytes.tttt in [0..3]) then ioresc_bkgnd(uep, znodevice); {unrecognized unit type} if dev<>device_table[status_bytes.tttt] then ioresc_bkgnd(uep, znodevice); {wrong unit type} end; {then} end; {clear_unit} $page$ {  if Simon_no_dma(uep) then ioresc_bkgnd(uep, zbaddma); if uep^.ureportchange and not uep^.umediavalid then ioresc_bkgnd(uep, zmediumchanged); if position mod 256<>0 then  procedures in the background transfer chain } procedure initial_seek (uep: uep_type); forward; procedure enter_transfer_chain (uep: anyptr); forward; procedure issue_transfer_request (uep: uep_type); forward; procedure initiate_data_trans ioresc_bkgnd(uep, zbadmode); if (position<0) or (length<0) or (position+length>fp^.fpeof) then ioresc_bkgnd(uep, ieof); HPIBcheck_sc(uep); ident := HPIBamigo_identfer (uep: anyptr); forward; procedure upon_data_transfer_comp(uep: anyptr); forward; procedure check_dsj (uep: anyptr); forward; { main driver procedure } procedure amigoio; var uep: uep_type; ident: shortint; asyncify(uep); {confirm device present} if dsj(uep)<>0 then {do nothing}; {remove power-on holdoff if any} if length=0 then deallocate_bkgnd_info(uep) {nothing to transfer} else hronous: boolean; begin {amigoio} uep := addr(unitable^[fp^.funit]); asynchronous := (request=startread) or (request=startwrite); if uep^.offline then ioresult := ord(znodevice) else try ioresult := ord(inoerror);  begin read_operation := (request=readbytes) or (request=startread); xfr_chain_semaphore := false; bx_tries := 0; bx_strt_rcrd : case request of clearunit: begin uep^.umediavalid := false; unit_wait(uep); ioresult := ord(inoerror); {forget any previous error} allocate_bkgnd_info(uep); = (position+fp^.fileid+uep^.byteoffset) div 256; bx_bufptr := addr(buffer); bx_length := length; initial_seek(uep); {initiate the transfer} end; { HPIBcheck_sc(uep); clear_unit(uep); deallocate_bkgnd_info(uep); end; unitstatus: fp^.fbusy := unit_busy(uep); flush: {do nothing}; readbytes, writebytes, selse} end; {with} if not asynchronous then begin unit_wait(uep); uep^.dvrtemp := ord(inoerror); {report synchronous errors only once} end; {if} tartread, startwrite: begin {transfer operations} unit_wait(uep); ioresult := ord(inoerror); {forget any previous error} allocate_bkgnd_info(uep); with bip_type(uep^.dvrtemp)^ do end; {transfer operations} otherwise {unrecognized request} ioresult := ord(ibadrequest); end; {cases} recover begin abort_bkgnd_process(uep); ioresult := uep^.dvrtemp; if not as     k} procedure enter_transfer_chain(uep: anyptr); begin {enter_transfer_chain} with bip_type(uep_type(uep)^.dvrtemp)^ do if not test_and_toggle(xfr_chain_semaphore) then repeat issue_transfer_request(uep); until test_a_resp(uep, initiate_data_transfer) else initiate_data_transfer(uep); recover abort_bkgnd_process(uep); end; {issue_transfer_request} $page$ procedure initiate_data_transfer(uep: anyptr); const tfr_data_sec = 0; begin {inind_toggle(xfr_chain_semaphore); end; {enter_transfer_chain} $page$ procedure issue_transfer_request(uep: uep_type); const sect_per_surf = 400*48; {only valid for 7905/06!!!} var transfer_command: command_type; transfer_cmd_buf: ftcb_typtiate_data_transfer} with bip_type(uep_type(uep)^.dvrtemp)^ do try HPIBupon_dxfr_comp(uep, tfr_data_sec, bx_bufptr, bx_tfr_length, upon_data_transfer_comp); recover abort_bkgnd_process(uep); end; {initiate_data_transfer} ynchronous then uep^.dvrtemp := ord(inoerror); {report synchronous errors only once} end; {recover} end; {amigoio} $page$ procedure initial_seek(uep: uep_type); var status_bytes: status_type; begin {initial_seek} if dee; max_tfr_length: integer; remaining_surf_bytes: integer; wait_for_ppol: boolean; begin {issue_transfer_request} with bip_type(uep^.dvrtemp)^ do try if buffered_transfer then begin if read_operation vice(uep)=HP9895 then {read status to determine single or double-sided} begin status(uep, status_bytes); with status_bytes do {specifically disallow non HP-formatted discs} begin if f then begin  then transfer_command := buf_read_cmd else transfer_command := buf_write_cmd; max_tfr_length := 256; end {then} else begin if read_operation then transfer_command : uep^.umediavalid := false; if uep^.ureportchange then ioresc_bkgnd(uep, zmediumchanged); end; {if} if (ss=0) and not (tttt in [2,6]) then ioresc_bkgnd(uep, zuninitiali= unbuf_read_cmd else transfer_command := unbuf_write_cmd; if MI_controller(uep) then begin max_tfr_length := 65536; {max DMA burst length} if surface_mode(uep) then {don't try to crozed) end; {with} end; {if} with bip_type(uep^.dvrtemp)^ do begin if MI_controller(uep) then begin set_file_mask(uep); buffered_transfer := not Simon_DMA(uep); HPIBwait_for_ppss a surface boundary} begin remaining_surf_bytes := (sect_per_surf-bx_strt_rcrd mod sect_per_surf)*256; if remaining_surf_bytesinoerror then escape(-10); HPIBupon_ppol_resp(uep, check_dsj); recover abort_bkgnd_process(uep); crd then {careful with MAC/IDC verify address!} begin bx_tries := bx_tries+1; transfer_successful := false; {unless correctable below} if (s1=possibly_correctabend; {upon_data_transfer_comp} procedure check_dsj(uep: anyptr); var transfer_successful: boolean; const maxtries = 10; procedure process_errors(uep: uep_type); var status_bytes: status_type; syndrome_bytes: syndrome_type; le_data_error) and (bx_tries>5) then with syndrome_bytes do begin syndrome(uep, syndrome_bytes); if (sb_s1=possibly_correctable_data_error) a cb_ptr: charptr; cb_index: shortint; e_rcrd: integer; possible_bytes_transferred: integer; begin {process_errors} with bip_type(uep^.dvrtemp)^ do begin status(uep, status_bytes); if dsj(uep)<>0 nd (decoded_addr(uep, sb_tva)=e_rcrd) and (sb_offset>=0) and (sb_offset<=125) then {it's correctable!then ioresc_bkgnd(uep, zcatchall); with status_bytes do case s1 of {retryable errors} cylinder_compare_error, uncorrectable_data_error, head_sector_compare_error, } begin cb_ptr := addr(bx_bufptr^,2*sb_offset); cb_index := 0; while (cb_index<6) and  end_of_cylinder, sync_bit_not_received_in_time, overrun, possibly_correctable_data_error, illegal_access_to_spare_track, defective_track, access_not_read (integer(cb_ptr)0 then if MI_controller(uep) or not transfer_successful then begin if device(uep) in [HP913X ioresc_bkgnd(uep, zmediumchanged); bx_tries := bx_tries+1; if bx_tries>1 then ioresc_bkgnd(uep, zcatchall); transfer_successful := false; _A..HP913X_C, HP7905..HP7925] then addr_record(uep, bx_strt_rcrd) else seek (uep, bx_strt_rcrd); HPIBupon_ppol_resp(uep, enter_transfer_chain); end {then} else enter_trann begin possible_bytes_transferred := (e_rcrd-bx_strt_rcrd)*256; if bx_tfr_length>possible_bytes_transferred then bx_tfr_length := possible_bytes_transferred;  end {then} else ioresc_bkgnd(uep, zcatchall); end; drive_attention: begin if e then ioresc_bkgnd(uep, zbadhardware);  end {then} else if bx_tries>=maxtries then if s1 in [uncorrectable_data_error, possibly_correctable_data_error] then ioresc_bkgnd(uep, zbadbloc if c then begin e_rcrd := logical_addr(uep); if e_rcrd>(bx_strt_rcrd+(bx_tfr_length-1)div 256) then transfer_successful := true {already transferred enok) else ioresc_bkgnd(uep, znoblock); end; {retryable errors case} {immediate escape errors} illegal_drive_type, unit_unavailable: ioresc_bkgnd(uepugh bytes} else if e_rcrd>=records_per_medium(uep) then ioresc_bkgnd(uep, znosuchblk) else ioresc_bkgnd(uep, znoblock); end {the, znodevice); attempt_to_write_on_protected_track: ioresc_bkgnd(uep, zprotected); {errors requiring status 2 processing} status_2_error: begin if f then n} else ioresc_bkgnd(uep, zcatchall); end; {other errors} otherwise ioresc_bkgnd(uep, zcatchall); end; {case} end; {with} e uep^.umediavalid := false; if e then ioresc_bkgnd(uep, zbadhardware); case ss of 1: ioresc_bkgnd(uep, znotready); 2: ioresc_bkgnd(uep, znodevice); nd; {process_errors} $page$ begin {check_dsj} with bip_type(uep_type(uep)^.dvrtemp)^ do try if dsj(uep)=0 then if bdx_pre_eoi then ioresc_bkgnd(uep, zcatchall) {unresolved premature eoi!} else transf 3: ioresc_bkgnd(uep, znomedium); otherwise {test further conditions below}; end; {case} if not read_operation and w then ioresc_bkgnd(uep, zprotected); er_successful := true else process_errors(uep); {will set/clear transfer_successful, or escape} if transfer_successful then begin bx_strt_rcrd := bx_strt_rcrd+bx_tfr_length div 256; bx_bufptr :=     sfer_chain(uep) else deallocate_bkgnd_info(uep); recover abort_bkgnd_process(uep); end; {check_dsj} end; {amigodvr} { program AMIGOinit } import loader; begin {AMIGOinit} markuser; end. {AMIGOinit}  subset80: boolean; multiport: boolean; multiunit: boolean; end; sva_type = {single-vector address (6 bytes)} packed record utb: signed16; {upper two bytes} lfb: integer;  (* (c) Copyright Hewlett-Packard Company, 1983. All rights are reserved. Copying or other reproduction of this program except for archival purposes is prohibited without the prior written consent of Hewlett-{lower four bytes (all we manage internally)} end; describe_type = {info returned by describe of unit other than controller} packed record {CONTROLLER DESCRIPTION FIELD} iu: signed16; {instPackard Company. RESTRICTED RIGHTS LEGEND Use, duplication, or disclosure by the Government is subject to restrictions as set forth in paragraph (b) (3) (B) of the Rights in Technical Data and Computer Software clause in DAR 7-104.9(a). HEWalled unit word: 1 bit per unit} mitr: signed16; {max instantaneous xfr rate (Kbytes)} ct: ct_type; {controller type} {UNIT DESCRIPTION FIELD} dt: signed8; LETT-PACKARD COMPANY Fort Collins, Colorado *) $modcal$ $debug off, range off, ovflcheck off$ $stackcheck off, iocheck off$ $ALLOW_PACKED ON$ {JWS 3/31/87} $copyright 'COPYRIGHT (C) 1983 BY HEWLETT-PACKARD COMPANY'$ $search 'DR {generic device type} dn: unsgn24; {device number (6 BCD digits)} nbpb: signed16; {# of bytes per block} nbb: unsgn8; {# of blocks which can be buffered} rbs: unsgn8; VASM', 'DISCHPIB' {, 'IOLIB:KERNEL'} $ {$SEARCH 'DRVASM','DISCHPIB'$} program CS80init; module tapebuf; import sysglobals, bkgnd; export const tapebuf_maxsize = 1024; type tapebuf_type = packed array[0..tapebuf_maxsize-1] of byte; tap {recommended burst size} blocktime: signed16; {block time in microseconds} catr: signed16; {continuous avg xfr rate (Kbytes)} ort: signed16; {optimal retry time in centisebuf_state_type = (undefined, unmodified, modified); var tapebuf_ptr: ^tapebuf_type; tapebuf_state: tapebuf_state_type; tapebuf_uep: uep_type; tapebuf_block: integer; tapebuf_size: integer; procedure init_tapebuf; implement {tapebueconds} atp: signed16; {access time parameter in centiseconds} mif: unsgn8; {maximum interleave factor} fvb: unsgn8; {fixed volume byte: 1 bit/volume} rvb: unsgn8; f} procedure init_tapebuf; begin {init_tapebuf} if tapebuf_ptr=nil then new(tapebuf_ptr); tapebuf_state := undefined; end; {init_tapebuf} end; {tapebuf} $page$ module CS80; {Command Set '80} import sysglobals, bkgnd, discHPIB; expo {removeable volume byte: 1 bit/vol} {VOLUME DESCRIPTION FIELD} maxcadd: unsgn24; {maximum cylinder address} maxhadd: unsgn8; {maximum head address} maxsadd: signed16; rt type signed16 = -32768..32767; signed8 = -128..127; unsgn24 = 0..16777215; unsgn8 = 0..255; unsgn4 = 0..15; ct_type = {controller type field in describe} packed record b7, b6, b5, b4, b3: boolean;  {maximum sector address} maxsvadd: sva_type; {maximum single-vector address} currentif: unsgn8; {current interleave factor} end; $page$ evu_type = {encoded volume/unit (1 byte) - status & cop      unrecoverable_data, {42} eb42, {43} end_of_file, {44} end_of_volume, {45} eb45, {46} eb46, {47} eb47, {INFORMATION ERRORS FIELD} {48} operator_request, {49} diagnoserable block address} end; {case} $page$ t_type = {'T' parameter in SET_RELEASE} ( allow_release_timeout, {power-on default} suppress_release_timeout); z_type = {'Z' parameter in SET_RELEASE} (disable_auto_reltic_request, {50} internal_maintenance_request, {51} media_wear, {52} latency_induced, {53} eb53, {54} eb54, {55} auto_sparing_invoked, {56} eb56, {57} recoverable_data_overflow, ease, {power-on default} enable_auto_release); CMD_type = {enumerated opcodes for device commands} (CMDlocate_and_read, CMD1 , CMDlocate_and_wrt , CMD3 , CMDlocate_and_ver , CMD5 , CMDspare_by commands} packed record case integer of 0: (vvvv: unsgn4; {volume number} uuuu: unsgn4); {unit number} 1: (evu_byte: signed8); {for -1 test} end; errorbit_type = {error bit assignments in status &  {58} marginal_data, {59} recoverable_data, {60} eb60, {61} maintenance_track_overflow, {62} eb62, {63} eb63 ); status_mask_type = packed array[errorbit_type] of boolean; status_type =status mask} ( {REJECT ERRORS FIELD} { 0} eb0, { 1} eb1, { 2} channel_parity_error, { 3} eb3, { 4} eb4, { 5} illegal_opcode, { 6} module_addressing, { 7} addres packed record {IDENTIFICATION FIELD} current_vu: evu_type; {current volume/unit} requesting_unit: signed8; {unit requesting service} {ERRs_bounds, { 8} parameter_bounds, { 9} illegal_parameter, {10} message_sequence, {11} eb11, {12} message_length, {13} eb13, {14} eb14, {15} eb15, {FAULT ERRORS FIELD} OR REPORTING FIELDS} errorbits: status_mask_type; {PARAMETER FIELD} case integer of {positive cases correspond to error bits} -1: (nta: sva_type; {new target address}  {16} eb16, {17} cross_unit, {18} eb18, {19} controller_fault, {20} eb20, {21} eb21, {22} unit_fault, {23} eb23, {24} diagnostic_result, {25} eb25, {26} opera faultlog: integer); {fault log} -2: (aaa: sva_type; {affected area address} afl: integer); {affected field length} 17: (uee: packed tor_release_required, {27} diagnostic_release_required, {28} internal_maintenance_required, {29} eb29, {30} power_fail, {31} retransmit, {ACCESS ERRORS FIELD} {32} illegal_parallel_opearray[1..6] of signed8); {units experiencing errors} 24: (dor: packed array[1..6] of unsgn8); {diagnostic results} 38: (ta: sva_type); {target address} 41: (bba: sva_type); ration, {33} uninitialized_media, {34} no_spares_available, {35} not_ready, {36} write_protect, {37} no_data_found, {38} eb38, {39} eb39, {40} unrecoverable_data_overflow, {41} {bad block address} 48..50: (urr: packed array[1..6] of signed8); {units requesting release} 58: (btbs: sva_type); {block to be spared} 59: (rba: sva_type); {recov     lock , CMD7 , CMDcopy_data , CMD9 , CMDcold_load_read , CMD11 , CMD12 , CMDrequest_status , CMDrelease , CMDrelease_denied , CMDset_address_1V , CMDset_address_3V , CMDset_block_disp , CMD , CMD108 , CMD109 , CMD110 , CMD111 , CMD112 , CMD113 , CMD114 , CMD115 , CMD116 , CMD117 , CMD118 , CMD119 , CMD1219 , CMD20 , CMD21 , CMD22 , CMD23 , CMDset_length , CMD25 , CMD26 , CMD27 , CMD28 , CMD29 , CMD30 , CMD31 0 , CMD121 , CMD122 , CMD123 , CMD124 , CMD125 , CMD126 , CMD127 , CMD128 {the field width is forced to 8 bits for packing considerations} ); const transparen , CMDset_unit_0 , CMDset_unit_1 , CMDset_unit_2 , CMDset_unit_3 , CMDset_unit_4 , CMDset_unit_5 , CMDset_unit_6 , CMDset_unit_7 , CMDset_unit_8 , CMDset_unit_9 , CMDset_unit_10 , CMDset_unit_11 , CMDset_ut_sec = 18; command_sec = 5; execution_sec = 14; reporting_sec = 16; $page$ errorbits_owning_parmfield = {errorbits which set the parameter field} [ {REJECT ERRORS FIELD} { 0} eb0, nit_12 , CMDset_unit_13 , CMDset_unit_14 , CMDset_unit_15 , CMDinit_util_NEM , CMDinit_util_REM , CMDinit_util_SEM , CMDinit_diagnostic, CMDno_op , CMDdescribe , CMD54 , CMDinit_media , CMDset_options , C {unknown, but assumed} { 1} eb1, {unknown, but assumed} { 3} eb3, {unknown, but assumed} { 4} eb4, {unknown, but assumed} {11} ebMDset_rps , CMDset_retry_time , CMDset_release , CMDset_burst_LBO , CMDset_burst_ABT , CMDset_status_mask, CMD63 , CMDset_vol_0 , CMDset_vol_1 , CMDset_vol_2 , CMDset_vol_3 , CMDset_vol_4 , CMDset_vol_5 11, {unknown, but assumed} {13} eb13, {unknown, but assumed} {14} eb14, {unknown, but assumed} {15} eb15, {unknown, b , CMDset_vol_6 , CMDset_vol_7 , CMDset_retadd_mode, CMDwrite_file_mark, CMDunload , CMD75 , CMD76 , CMD77 , CMD78 , CMD79 , CMD80 , CMD81 , CMD82 ut assumed} {FAULT ERRORS FIELD} {16} eb16, {unknown, but assumed} {17} cross_unit, {18} eb18, {unknown, but assumed} {20} eb20,  , CMD83 , CMD84 , CMD85 , CMD86 , CMD87 , CMD88 , CMD89 , CMD90 , CMD91 , CMD92 , CMD93 , CMD94 ,  {unknown, but assumed} {21} eb21, {unknown, but assumed} {23} eb23, {unknown, but assumed} {24} diagnostic_result, {25} eb25, CMD95 , CMD96 , CMD97 , CMD98 , CMD99 , CMD100 , CMD101 , CMD102 , CMD103 , CMD104 , CMD105 , CMD106 , CMD107  {unknown, but assumed} {29} eb29, {unknown, but assumed} {ACCESS ERRORS FIELD} {38} eb38, {unknown, but assumed} {39} eb39, {u     _clr (uep: uep_type): unsgn8; function set_unit (uep: uep_type; unit: unsgn4): unsgn8; function set_unitvol (uep: uep_type): unsgn8; function status (uep: uep_type; var status_bytes: status_type): unsgn8; function release issue the specified command } var c: {the 1-byte command message} packed record cmd: CMD_type; end; begin {ICc} c.cmd := cmd; HPIBshort_msge_out(uep, command_sec, addr(c), sizeof(c)); end; {ICc} procedure ICuc(uep: (uep: uep_type; unit: unsgn4): unsgn8; function describe (uep: uep_type; var describe_bytes: describe_type): unsgn8; function set_release (uep: uep_type; t: t_type; z: z_type): unsgn8; function set_options (uep: uep_type; options_by uep_type; unit: unsgn4; cmd: CMD_type); { issue the specified SET_UNIT & command } var uc: {the 2-byte command message} packed record setunit: CMD_type; cmd: CMD_type; end; begin {ICuc} uc.setunit := CMD_typnknown, but assumed} {41} unrecoverable_data, {42} eb42, {unknown, but assumed} {45} eb45, {unknown, but assumed} {46} eb46, {unknown, bte: unsgn8): unsgn8; function set_status_mask (uep: uep_type; status_mask: status_mask_type): unsgn8; { NOTE: The following routines do not, in themselves, perform a complete transaction. They provide some of the messages necessary for ut assumed} {47} eb47, {unknown, but assumed} {INFORMATION ERRORS FIELD} {48} operator_request, {49} diagnostic_request, {50} internal_maintenance_request, {53} eb53 transactions which are broken apart to allow overlapped transfers. } procedure ICuvalc (uep: uep_type; address, len: integer; cmd: CMD_type); function qstat (uep: uep_type): unsgn8; implement {CS80} var most_recent_status: status_ty, {unknown, but assumed} {54} eb54, {unknown, but assumed} {56} eb56, {unknown, but assumed} {58} marginal_data, {59} recoverable_data, pe; {for post-mortem diagnostic purposes only!!!} function qstat(uep: uep_type): unsgn8; { receive a REPORTING message return the QSTAT byte } var qstat_byte: {the 1 byte in the reporting message} packed record b: unsgn8; {60} eb60, {unknown, but assumed} {62} eb62, {unknown, but assumed} {63} eb63 {unknown, but assumed} ]; errorbits_requesting_release end; begin {qstat} HPIBshort_msge_in(uep, reporting_sec, addr(qstat_byte), sizeof(qstat_byte)); qstat := qstat_byte.b; end; {qstat} $page$ function chan_indep_clr(uep: uep_type): unsgn8; { issue the CHANNEL_INDEPENDENT_CLEAR comma = {errorbits which request release} [ {48} operator_request, {49} diagnostic_request, {50} internal_maintenance_request ]; $page$ { NOTE: the following functions each perform a COMPLETE transaction. They: nd return the QSTAT byte } var cic: {the 2 bytes in the channel independent clear command message} packed record setunit: CMD_type; ci_clr: unsgn8; end; begin {chan_indep_clr} cic.setunit := CMD_type(signed16(C . issue a (device or transparent) command (Command message) . transfer data if applicable (Execution message) . return the resulting QSTAT (Reporting message) } function chan_indepMDset_unit_0)+uep^.du); cic.ci_clr := 8; HPIBshort_msge_out(uep, transparent_sec, addr(cic), sizeof(cic)); HPIBwait_for_ppol(uep); chan_indep_clr := qstat(uep); end; {chan_indep_clr} procedure ICc(uep: uep_type; cmd: CMD_type); {      e(signed16(CMDset_unit_0)+unit); uc.cmd := cmd; HPIBshort_msge_out(uep, command_sec, addr(uc), sizeof(uc)); end; {ICuc} $page$ function set_unit(uep: uep_type; unit: unsgn4): unsgn8; { issue the SET_UNIT command return the QSTAT byte es in the SET_UNIT & SET_RELEASE command message} packed record setunit: CMD_type; setrel: CMD_type; Tbit: t_type; Zbit: z_type; pad: 0..63; end; begin {set_release} sr.setunit := CMDset_unit_15; { } begin {set_unit} ICc(uep, CMD_type(signed16(CMDset_unit_0)+unit)); HPIBwait_for_ppol(uep); set_unit := qstat(uep); end; {set_unit} function set_unitvol(uep: uep_type): unsgn8; { issue the SET_UNIT & SET_VOLUME commands returnalways addressed to the controller} sr.setrel := CMDset_release; sr.Tbit := t; sr.Zbit := z; sr.pad := 0; HPIBshort_msge_out(uep, command_sec, addr(sr), sizeof(sr)); HPIBwait_for_ppol(uep); set_release := qstat(uep);  the QSTAT byte } begin {set_unitvol} ICuc(uep, uep^.du, CMD_type(signed16(CMDset_vol_0)+uep^.dv)); HPIBwait_for_ppol(uep); set_unitvol := qstat(uep); end; {set_unitvol} function status(uep: uep_type; var status_bytes: status_type): uns end; {set_release} function set_options(uep: uep_type; options_byte: unsgn8): unsgn8; var so: {the 2 bytes in the SET_OPTIONS command message} packed record setoptn: CMD_type; ob: unsgn8; end; begin {set_options} gn8; { issue the REQUEST_STATUS command place the 20 bytes of status in the passed variable 'status_bytes' return the QSTAT byte } begin {status} ICc(uep, CMDrequest_status); HPIBwait_for_ppol(uep); HPIBshort_msge_in(uep, exec so.setoptn := CMDset_options; so.ob := options_byte; HPIBshort_msge_out(uep, command_sec, addr(so), sizeof(so)); HPIBwait_for_ppol(uep); set_options := qstat(uep); end; {set_options} $page$ function set_status_mask(uep: uep_type; sution_sec, addr(status_bytes), sizeof(status_bytes)); most_recent_status := status_bytes; {for post-mortem diagnostic purposes only!!!} HPIBwait_for_ppol(uep); status := qstat(uep); end; {status} function release(uep: uep_type; unit: unsgntatus_mask: status_mask_type): unsgn8; var ssm: {the 10 bytes in the SET_STATUS_MASK command message} packed record nop: CMD_type; setstsmsk: CMD_type; stsmsk: status_mask_type; end; begin {set_status_mask} s4): unsgn8; { SET_UNIT & issue the RELEASE command return the QSTAT byte } begin {release} ICuc(uep, unit, CMDrelease); HPIBwait_for_ppol(uep); release := qstat(uep); end; {release} $page$ function describe(uep: uep_type; var dsm.nop := CMDno_op; ssm.setstsmsk := CMDset_status_mask; ssm.stsmsk := status_mask; HPIBshort_msge_out(uep, command_sec, addr(ssm), sizeof(ssm)); HPIBwait_for_ppol(uep); set_status_mask := qstat(uep); end; {set_status_mask} escribe_bytes: describe_type): unsgn8; { issue the DESCRIBE command place the 37 bytes of description in the passed variable 'describe_bytes' return the QSTAT byte } begin {describe} ICc(uep, CMDdescribe); HPIBwait_for_ppol(uep);  procedure ICuvalc(uep: uep_type; address, len: integer; cmd: CMD_type); { issue the following command sequence: . SET_UNIT (u) . SET_VOLUME (v) . SET_ADDRESS (a) . SET_LENGTH  HPIBshort_msge_in(uep, execution_sec, addr(describe_bytes), sizeof(describe_bytes)); HPIBwait_for_ppol(uep); describe := qstat(uep); end; {describe} function set_release(uep: uep_type; t: t_type; z: z_type): unsgn8; var sr: {the 3 byt (l) . specified COMMAND (c) } var uvalc: {the 17 bytes in the command message} packed record setunit: CMD_type; {set unit} setvol: CMD_type; {set volume} nop1: CMD_type; {nop}      ffected!} then {invalidate all CS80 state info!} begin scanner_uep^.umediavalid := false; {media possibly changed} scanner_uep^.dvrtemp2 := -1; {block size possibly changed!} if scanner_uep=tapd tape; allow access anyway} else working_iorval := zuninitialized; no_spares_available: working_iorval := zinitfail; not_ready: working_iorval := znotready; ebuf_uep then tapebuf_state := undefined; end; {if} end; {for} end; {invalidate_stateinfo} $page$ procedure handle_bad_status(uep: uep_type; ok_to_config: boolean; var retry_required: boolean); var iorval_to_report:  write_protect: working_iorval := zprotected; no_data_found, end_of_file: working_iorval := znoblock; unrecoverable_data_overflow, unrecoverasetadd: CMD_type; {set address} sva: sva_type; {single vector address} nop2: CMD_type; {nop} setlen: CMD_type; {set length} length: integer; {length} cmd: CMD_type; {speciiorsltwd; {to hold the first reportable error} working_iorval: iorsltwd; {cleared each time status is read} status_bytes: status_type; eb_scan, parameter_field_owner: errorbit_type; reconfiguration_needed: boolean; begin {handle_bad_stfied command} end; begin {ICuvalc} uvalc.setunit := CMD_type(signed16(CMDset_unit_0)+uep^.du); uvalc.setvol := CMD_type(signed16(CMDset_vol_0)+uep^.dv); uvalc.nop1 := CMDno_op; uvalc.setadd := CMDset_address_1V; uvalc.sva.uatus} iorval_to_report := inoerror; repeat if status(uep, status_bytes)<>0 then ioresc_bkgnd(uep, zbadhardware); working_iorval := inoerror; parameter_field_owner := channel_parity_error; {doesn't REALLY own it!} tb := 0; uvalc.sva.lfb := address; uvalc.nop2 := CMDno_op; uvalc.setlen := CMDset_length; uvalc.length := len; uvalc.cmd := cmd; HPIBshort_msge_out(uep, command_sec, addr(uvalc), sizeof(uvalc)); end; {ICuvalc} end; {CS80 reconfiguration_needed := false; for eb_scan := eb63 downto eb0 do if status_bytes.errorbits[eb_scan] then begin if eb_scan in errorbits_owning_parmfield then parameter_field_owner := eb_scan; } $page$ module CS80dsr; {Command Set '80 Driver Support Routines} import sysglobals, bkgnd, tapebuf, CS80; export procedure invalidate_stateinfo(uep: uep_type); procedure handle_bad_status(uep: uep_type; ok_to_config: boolean; var retry_require case eb_scan of {specific fatal errors} channel_parity_error, controller_fault, unit_fault, diagnostic_result: working_iorval := zbadhardware; d: boolean); procedure configure(uep: uep_type); implement {CS80dsr} procedure invalidate_stateinfo(uep: uep_type); var lun: unitnum; scanner_uep: uep_type; begin {invalidate_stateinfo} for lun := 1 to maxunit do begin s illegal_opcode, parameter_bounds, illegal_parameter: working_iorval := zbadmode; {some cmds optional in SS/80} module_addressing: working_iorval := znodevice; canner_uep := addr(unitable^[lun]); if (scanner_uep^.letter='Q') and (scanner_uep^.sc = uep^.sc) and (scanner_uep^.ba = uep^.ba) and (scanner_uep^.du = uep^.du) {don't qualify dv because all volumes ARE a address_bounds, end_of_volume: working_iorval := znosuchblk; uninitialized_media: if status_bytes.errorbits[power_fail] then {probably an uncertifie     ble_data: working_iorval := zbadblock; {power fail} power_fail: begin invalidate_stateinfo(uep); if uep^.ureportchange then e above cases} otherwise { specifically including: message_sequence, message_length, cross_unit, illegal_parallel_operatio working_iorval := zmediumchanged; reconfiguration_needed := true; retry_required := true; end; {retryable errors} operator_release_required, n } working_iorval := zcatchall; end; {case} end; {if} $page$ if iorval_to_report=inoerror then {none previously found; report this one} iorval_to_report := working_iorval; {it can be inoerror al diagnostic_release_required, internal_maintenance_required, retransmit: retry_required := true; {errors indicating release requested} operator_request, diso!} if parameter_field_owner in errorbits_requesting_release then if not (status_bytes.urr[1] in [0..15]) then ioresc_bkgnd(uep, zcatchall) else if release(uep, status_bytes.urr[1])<>0 then {handle the bad qstat agnostic_request, internal_maintenance_request: {do nothing here; release below if parmeter field owned}; {errors indicating reconfiguration needed} media_wear, {supposeelsewhere; worry not, the device won't forget!}; if reconfiguration_needed and ok_to_config then configure(uep); until set_unit(uep, status_bytes.current_vu.uuuu)=0; {restore original command unit} if iorval_to_report<>inoerror thd to be masked out} latency_induced, {supposed to be masked out} eb53, {supposed to be masked out} eb54, {supposed to be masked out} en ioresc_bkgnd(uep, iorval_to_report); end; {handle_bad_status} procedure configure(uep: uep_type); var escape_caught: boolean; saved_ureportchange: boolean; retry_required: boolean; describe_bytes: describe_type; bcd_pro auto_sparing_invoked, {supposed to be masked out} eb56, {supposed to be masked out} recoverable_data_overflow, {supposed to be masked out} marginal_data, d_num: {within the describe bytes} packed record case integer of 0: (dn: unsgn24); 1: (bcd: packed array[1..6] of unsgn4); end; fixed_volume_byte: packed record case integer of 0: (b: unsgn8); 1: (bit: {supposed to be masked out} recoverable_data, {supposed to be masked out} eb60, {supposed to be masked out} maintenance_track_overflow, {supposed to be  packed array[0..7] of boolean); end; prod_num: signed16; index: signed16; const masked = true; unmasked = false; my_status_mask = status_mask_type [ {REJECT ERRORS FIELD} { 0 eb0: masked out} eb62, {supposed to be masked out} eb63: {supposed to be masked out} reconfiguration_needed := true; {errors not covered by th } unmasked, { 1 eb1: } unmasked, { 2 channel_parity_error: } unmasked, { 3 eb3: } unmasked, { 4 eb4: } unmasked,       } unmasked, {unmaskable error} {28 internal_maintenance_required: } unmasked, {unmaskable error} {29 eb29: } unmasked, {unmaskable error} {30 power_fail: } unmasked, {unmaskance_track_overflow: } masked, {62 eb62: } masked, {63 eb63: } masked ]; $page$ begin {configure} with uep^ do begin escape_caught := false; saved_ble error} {31 retransmit: } unmasked, {unmaskable error} {ACCESS ERRORS FIELD} {32 illegal_parallel_operation: } unmasked, {33 uninitialized_media: } unmasked, {34 no_sparureportchange := ureportchange; try ureportchange := false; {NEVER report media change while in configure} {configure the control unit} repeat retry_required := false; if set_release(uep, all { 5 illegal_opcode: } unmasked, { 6 module_addressing: } unmasked, { 7 address_bounds: } unmasked, { 8 parameter_bounds: } unmasked, { 9 illegal_parameter: es_available: } unmasked, {35 not_ready: } unmasked, {36 write_protect: } unmasked, {37 no_data_found: } unmasked, {38 eb38: } unma } unmasked, {10 message_sequence: } unmasked, {11 eb11: } unmasked, {12 message_length: } unmasked, {13 eb13: } unmasked, {14 ebsked, {39 eb39: } unmasked, {40 unrecoverable_data_overflow: } unmasked, {41 unrecoverable_data: } unmasked, {42 eb42: } unmasked, {43 end_of_file: 14: } unmasked, {15 eb15: } unmasked, {FAULT ERRORS FIELD} {16 eb16: } unmasked, {unmaskable error} {17 cross_unit:  } unmasked, {44 end_of_volume: } unmasked, {45 eb45: } unmasked, {46 eb46: } unmasked, {47 eb47: } unmasked, } unmasked, {unmaskable error} {18 eb18: } unmasked, {unmaskable error} {19 controller_fault: } unmasked, {unmaskable error} {20 eb20: } unmasked, {unmaskabl {INFORMATION ERRORS FIELD} {48 operator_request: } unmasked, {49 diagnostic_request: } unmasked, {50 internal_maintenance_request: } unmasked, {51 media_wear: } me error} {21 eb21: } unmasked, {unmaskable error} {22 unit_fault: } unmasked, {unmaskable error} {23 eb23: } unmasked, {unmaskable error} {24 diagnasked, {52 latency_induced: } masked, {53 eb53: } masked, {54 eb54: } masked, {55 auto_sparing_invoked: } masked, {56 eb56: ostic_result: } unmasked, {unmaskable error} {25 eb25: } unmasked, {unmaskable error} {26 operator_release_required: } unmasked, {unmaskable error} {27 diagnostic_release_required:  } masked, {57 recoverable_data_overflow: } masked, {58 marginal_data: } masked, {59 recoverable_data: } masked, {60 eb60: } masked, {61 maintena     ow_release_timeout, disable_auto_release)<>0 then handle_bad_status(uep, false, retry_required); until not retry_required; repeat retry_required := false; if set_status_mask(uep, my_status_mask)<>0axsvadd.lfb+1)*nbpb; if dt=2 then {it's a tape} repeat {enable auto-jump sparing} retry_required := false; if set_options(uep, 4)<>0 then handle_bad_status(uep, false, then handle_bad_status(uep, false, retry_required); until not retry_required; {configure the required unit} repeat retry_required := false; if chan_indep_clr(uep)<>0 then  retry_required); until not retry_required; repeat retry_required := false; if set_status_mask(uep, my_status_mask)<>0 then handle_bad_status(uep, false, retry_required);  handle_bad_status(uep, false, retry_required); until not retry_required; repeat retry_required := false; if set_unitvol(uep)<>0 then handle_bad_status(uep, false, retry_required); until  until not retry_required; end; {with} recover escape_caught := true; ureportchange := saved_ureportchange; if escape_caught then escape(escapecode); end; {with} end; {configure} not retry_required; repeat retry_required := false; if describe(uep, describe_bytes)<>0 then handle_bad_status(uep, false, retry_required); until not retry_required; with describe_bytes  end; {CS80dsr} $page$ module CS80dvr; {Command Set '80 Driver} import sysglobals, asm, mini, drvasm, bkgnd, discHPIB, tapebuf, CS80, CS80dsr; export type mp_type = {media parameters} record tpm: integer; {tracks per medium} do begin bcd_prod_num.dn := dn; prod_num := 0; for index := 1 to 5 do prod_num := prod_num*10+bcd_prod_num.bcd[index]; if ( (devid<>prod_num) and (devid<>-1) ) {wrong pr bpt: integer; {bytes per track} end; procedure get_letter(uep: uep_type; ident: shortint; var letter: char); procedure get_parms(var devtype: byte; var devid: integer; var hardvols: shortint; var mp: mp_type); procoduct number} or ( dt<0 ) {can't detect media change} then ioresc_bkgnd(uep, znodevice); dvrtemp2 := 0; index := nbpb; while (index>0) and not odd(index)edure CS80io(fp: fibp; request: amrequesttype; anyvar buffer: window; length, position: integer); implement {CS80dvr} var CS80_devtype: byte; CS80_devid: integer; CS80_hardvols: shortint; CS80_mp: mp_type; procedure clear_uni do begin dvrtemp2 := dvrtemp2+1; index := index div 2; end; {while} if index<>1 then {blocksize isn't a power of 2!} dvrtemp2 := -1; {don't panic; might be t(uep: uep_type); begin {clear_unit} try allocate_bkgnd_info(uep); HPIBcheck_sc(uep); if HPIBamigo_identify(uep) div 256<>2 then ioresc_bkgnd(uep, znodevice); configure(uep); deallocate_bkgnd_info(uep); recovjust no medium present} fixed_volume_byte.b := fvb; {fixed volume byte} uisfixed := fixed_volume_byte.bit[7-dv]; if devid=-1 then {variable-sized removeable volume; set its size} umaxbytes := (mer abort_bkgnd_process(uep); end; {clear_unit} { procedures for CTABLE self-configuration } procedure get_parms(var devtype: byte; var devid: integer; var hardvols: shortint; var mp: mp_type); begin {get_parms} devtyp     e.bools[index]); with CS80_mp do begin tpm := (maxcadd+1)*(maxhadd+1); {tracks per medium} if tpm=1 {only single-vector addressing info given} then bpt := (maxsvadd.lfb+1)*nbpb {bytes per track}age$ { tapebuf manipulation routines } procedure flush_tapebuf; var escape_caught: boolean; saved_ureportchange: boolean; begin {flush_tapebuf} if tapebuf_state=modified then with tapebuf_uep^ do begin escape_cau else bpt := (maxsadd+1)*nbpb; {bytes per track} end; {with} end; {with} letter := 'Q'; end; {get_letter} $page$ { low-level read/write routines } procedure flagit(uep: anyptr); begin {flagit} bip_type(ught := false; saved_ureportchange := ureportchange; try ureportchange := true; {don't flush out to different media!} tapebuf_state := undefined; {while attempting the write} xfr(tapebuf_uep, writebye := CS80_devtype; devid := CS80_devid; hardvols := CS80_hardvols; mp := CS80_mp; end; {get_parms} $page$ procedure get_letter(uep: uep_type; ident: shortint; var letter: char); var retry_required: boolean; describe_bytes: describeep_type(uep)^.dvrtemp)^.xfr_chain_semaphore := false; end; {flagit} procedure xfr(uep: uep_type; request: amrequesttype; bufptr: anyptr; block_address, length: integer); var command: CMD_type; retry_required: boolean; begin {x_type; bcd_prod_num: {within the describe bytes} packed record case integer of 0: (dn: unsgn24); 1: (bcd: packed array[1..6] of unsgn4); end; index: signed16; volumes_byte: {with the describe bytes} packed recfr} allocate_bkgnd_info(uep); with bip_type(uep^.dvrtemp)^ do try if HPIBamigo_identify(uep) div 256<>2 then ioresc_bkgnd(uep, znodevice); read_operation := (request=readbytes) or (request=startread); if reaord case integer of 0: (vb: unsgn8); 1: (bools: packed array[0..7] of boolean); end; begin {get_letter} uep^.ureportchange := false; {don't report media changes/power-on now!!!} repeat {cmd w/o execution msge avoids escad_operation then command := CMDlocate_and_read else command := CMDlocate_and_wrt; ICuvalc(uep, block_address, length, command); if length>0 then begin HPIBwait_for_ppol(uep); xfr_chain_pe if in power-on holdoff!} retry_required := false; if set_unitvol(uep)<>0 then handle_bad_status(uep, false, retry_required); {don't configure!!!} until not retry_required; repeat retry_required := false; if descsemaphore := true; {merely a flag for xfr busy here} HPIBupon_dxfr_comp(uep, execution_sec, bufptr, length, flagit); while xfr_chain_semaphore do {nothing}; if iores<>inoerror then escape(-10); eribe(uep, describe_bytes)<>0 then handle_bad_status(uep, false, retry_required); {don't configure!!!} until not retry_required; with describe_bytes do begin CS80_devtype := dt; bcd_prod_num.dn := dn; CS80_dend {if} else bdx_pre_eoi := false; HPIBwait_for_ppol(uep); retry_required := false; if qstat(uep)<>0 then handle_bad_status(uep, true, retry_required) else if bdx_pre_eoi then ioresc_bkvid := 0; for index := 1 to 5 do CS80_devid := CS80_devid*10+bcd_prod_num.bcd[index]; volumes_byte.vb := fvb+rvb; CS80_hardvols := 0; for index := 0 to 7 do CS80_hardvols := CS80_hardvols+ord(volumes_bytgnd(uep, zcatchall); {unresolved premature eoi!} deallocate_bkgnd_info(uep); recover abort_bkgnd_process(uep); ioresult := uep^.dvrtemp; if (ioresult<>ord(inoerror)) or retry_required then escape(-10); end; {xfr} $p     tes, tapebuf_ptr, tapebuf_block, tapebuf_size); tapebuf_state := unmodified; {write was successful!} recover escape_caught := true; ureportchange := saved_ureportchange; if escape_caught then g in i/o errors changes were made to always do full sector/block writes } procedure transfer(uep: uep_type; fp: fibp; request: amrequesttype; bufptr: charptr; abs_position, length: integer); type cp = ^char; var ret escape(escapecode); end; {with} end; {flush_tapebuf} procedure load_tapebuf(uep: uep_type; request: amrequesttype; block: integer); var xfr_required: boolean; begin {load_tapebuf} xfr_required := (tapebuf_uep<>uep) or (tapebuf_blry_required: boolean; blockpower: shortint; blocksize: integer; block, intra_block_offset, partial_length: integer; begin {transfer} repeat retry_required := false; try if uep^.dvrtemp2<0 then {block size unknown; ock<>block) or (tapebuf_state=undefined); if xfr_required then begin flush_tapebuf; tapebuf_uep := uep; tapebuf_block := block; tapebuf_state := undefined; end; {if} if not xfr_required {then conftry to determine} begin clear_unit(uep); ioresult := uep^.dvrtemp; if ioresult<>ord(inoerror) then escape(-10); end; {if} blockpower := uep^.dvrtemp2; if blockpower<0 thirm media present & unchanged} or (request=writebytes) {then confirm media not write protected} then begin xfr(tapebuf_uep, request, nil, tapebuf_block, 0); if tapebuf_state=undefined then xfr_required := true;en ioresc(znomedium); {this or block size isn't a power of 2!!!} blocksize := shifted_left(1, blockpower); if blocksize>tapebuf_maxsize then ioresc(zuninitialized); {our buffer is too small to handle} block : end; {if} if xfr_required then begin tapebuf_size := shifted_left(1, uep^.dvrtemp2); xfr(tapebuf_uep, readbytes, tapebuf_ptr, tapebuf_block, tapebuf_size); tapebuf_state := unmodified; {read was successful!} = shifted_right(abs_position, blockpower); intra_block_offset := mod_power_of_2(abs_position, blockpower); if blockpower<=8 then begin {handle a 256-byte or smaller block media} {bug 1 fix is to now just enforce block end; {if} end; {load_tapebuf} $page$ { read/write routine The new Subset/80 devices coming out which support multiple block sizes have forced us to abandon the 2.X driver's essentially never- used asynchronous capabilities. It's simply too di boundary start} if intra_block_offset<>0 then ioresc(zbadmode); { xfr(uep, request, bufptr, block, length); } {bug 1 fix} end ; {handle a 256-byte or smaller block device} $page$ {else} {rdq removed to force all fficult to handle the media change situation when the media's block size also changes. For instance, an asynchronous transfer started on the 256-byte block assumption might discover new media formatted to 1024-byte blocks, in which case entire tranoperations thru buffer handeling code } begin {handle buffering for up to tapebuf_maxsize block media} partial_length := blocksize-intra_block_offset; if partial_length>length then partial_length := length; csfer would need re-starting, this time using tapebuf for buffering. This situation would not be detected until well into the asynchronous transfer chain, at which point we could be deadlocked. bug 1: 10 june 88 partial sector writes were resultinase request of readbytes, startread: begin {read operations} if intra_block_offset>0 then {partial block at front} begin load_tapebuf(uep, readbytes, block);       block := shifted_right(abs_position, blockpower); length := length-partial_length; end; {if} partial_length := length-mod_power_of_2(length, blockpower); if partial_length>r begin if escapecode<>-10 then escape(escapecode); if ioresult=ord(inoerror) then {media changed; restart} retry_required := true; end; {recover} until not retry_required; if (request=0 then {one or more whole blocks remain} begin flush_tapebuf; {because we may travel far, far away} tapebuf_state := undefined; {in case this overwrites!} xfr(uep, wristartread) or (request=startwrite) then call(fp^.feot, fp) {call the end of transfer procedure} else uep^.dvrtemp := ord(inoerror); {report synchronous errors only once} end; {transfer} $page$ { CS80 transfer method request handler  moveleft(tapebuf_ptr^[intra_block_offset], bufptr^, partial_length); bufptr := addr(bufptr^, partial_length); abs_position := abs_position+partial_length; block := shifted_rtebytes, bufptr, block, partial_length); bufptr := addr(bufptr^, partial_length); abs_position := abs_position+partial_length; block := shifted_right(abs_position, blockpower); ight(abs_position, blockpower); length := length-partial_length; end; {if} if (length>=blocksize) {one or more blocks remain} or (blockpower<=8) then {bug 1, keep read perfo length := length-partial_length; end; {if} if length>0 then {a partial block remains} {rdq bug 1 fix, new code to zero pad small sectors instead of the read modify wrrmance for small blocks } begin flush_tapebuf; {because we may travel far, far away} xfr(uep, readbytes, bufptr, block, length); end else if length>0 thite operation used for big block sizes} if blockpower<=8 then begin { zero pad for blocksize<=256 } moveleft(bufptr^, tapebuf_ptr^, length); tapebuf_ptr^[length] := 0; en {partial block at back} begin load_tapebuf(uep, readbytes, block); moveleft(tapebuf_ptr^, bufptr^, length); end; end; {read operations}  moveleft(cp(addr(tapebuf_ptr^[length]))^, cp(addr(tapebuf_ptr^[length+1]))^, blocksize-length-1); xfr(uep, writebytes, tapebuf_ptr, block, blocksizewritebytes, startwrite: begin {write operations} if intra_block_offset>0 then {partial block at front} begin load_tapebuf(uep, writebytes, block); tapebuf_s); end else begin load_tapebuf(uep, writebytes, block); tapebuf_state := modified; moveleft(bufptr^, tapebuf_ptr^, length); tate := modified; moveleft(bufptr^, tapebuf_ptr^[intra_block_offset], partial_length); bufptr := addr(bufptr^, partial_length); abs_position := abs_position+partial_length;  end; {if} flush_tapebuf; {so errors get reported in the right place!} end; {write operations} end; {case} end; {handle buffering for up to tapebuf_maxsize block media} recove     } procedure CS80io; var uep: uep_type; begin {CS80io} ioresult := ord(inoerror); uep := addr(unitable^[fp^.funit]); if uep^.offline then ioresult := ord(znodevice) else case request of clearunit: be * IOLIB RS * * ****************************************************************************** * * * * Library - IOLIB * * Purpose - This set of assembly language code is intended to be used as * a PASCAL module for I/gin clear_unit(uep); ioresult := uep^.dvrtemp; uep^.dvrtemp := ord(inoerror); {report synchronous errors only once} if uep=tapebuf_uep then tapebuf_state := undefined; end; unitstatus: O drivers for use by the external I/O * procedures library. * * * Date - 8-6-82 * Update - 6-5-84 BY J Schmidt * Release - 7-12-85 * * * Source - RS: RS.TEXT * Object - RS: RS.CODE * * * * *************** fp^.fbusy := unit_busy(uep); flush: begin if uep=tapebuf_uep then try flush_tapebuf; recover if escapecode<>-10 then escape(escapecode); uep^.dvrt*************************************************************** * * * RELEASED VERSION 3.1 * * ****************************************************************************** * * CHANGES (since 2.0): * {aaa} -- changes for iemp := ord(inoerror); {report synchronous errors only once} end; readbytes, writebytes, startread, startwrite: begin uep^.dvrtemp := ord(inoerror); {report synchronous errors only once} if Simon_no_DMAgnore parity error register 20. * * CHANGES for 3.0 * {ttt} -- timing changes for 680xx -- JS 8/3/83, 5/3/84 * * CHANGES for 3.1 * (jws} -- new default setups, add control/status 21, 22. 6/5/85 * * CHANGES for 3.23 * (uep) then ioresult := ord(zbaddma) else if uep^.ureportchange and not uep^.umediavalid then ioresult := ord(zmediumchanged) else if (position<0) or (length<0) or (position+length>fp^.fpeof) then  {dew1} -- fixed timing problem with reset. DW 12/89 * ****************************************************************************** PAGE ****************************************************************************** * * * The fo ioresult := ord(ieof) else transfer(uep, fp, request, addr(buffer), position+fp^.fileid+uep^.byteoffset, length); end; otherwise {unrecognized request} ioresult := ord(ibadrequest); end; llowing lines are used to tell the LINKER/LOADER what this * module looks like in PASCAL terms. * * Note that it is possible to create assembly modules that are functions. * These routines are called through an indirect pointer using the {cases} end; {CS80io} end; {CS80dvr} $page$ { program CS80init } import tapebuf, loader; begin {CS80init} init_tapebuf; markuser; end. {CS80init} CALL * facility which does NOT permit functions. * * This module is called 'RS' ( upper or lower case - doesn't matter ) * independent of the file name ( by use of the MNAME pseudo-op ). * * All the externally used procedures are ca TTL IOLIB RS - RS232 DRIVERS ****************************************************************************** * * COPYRIGHT (C) 1985 BY HEWLETT-PACKARD COMPANY * ****************************************************************************** * *lled 'RS_@@@@@@@@' in * this module. If you are using assembly to access them use the * 'RS_@@@@@@@' name. If you are using Pascal use the '@@@@@@@' * name. * *****************************************************************************     *************************** LMODE ABORT_IO,LOGEOT REFA ABORT_IO,LOGEOT REFA DELAY_TIMER,CHECK_TIMER ttt JS 8/3/83 LMODE DELAY_TIMER,CHECK_TIMER ttt JS 8/3/83 INCLUDE COMDCL  - - - - - * set_xfer - I - - - - - - - - - * dump_buffer G I L L - O L L - L L * * NOTATION (in order of importance) * O : output parameter * I : input pa page * * REGISTER USAGE SUMMARY (of utility routines) * * Global Usage * a5 -- Pascal Global Base * a6 -- Pascal Stack Frame * a7 -- Stack Pointer * a1 -- Card Address * a2 -- Driver Attributes (rameter * G : used by routine (register has consistent meaning throughout routine * P : used to pass parameter to called routines * T : used by routine (temporary) * L : possible usage by called routines * -** MNAME RS SRC MODULE RS; SRC IMPORT iodeclarations; SRC EXPORT SRC SRC PROCEDURE rs_init ( temp : ANYPTR ); SRC PROCEDURE rs_isr ( temp : PISRIB ); SRC PROCEDUR'temp' space) * * ROUTINE a0 a3 a4 d0 d1 d2 d3 d4 d5 d6 d7 * ---------------------------------------------------------- * queue_space - - - - - - O - - - - * queue_empty - - - - E rs_rdb ( temp : ANYPTR ; VAR x : CHAR ); SRC PROCEDURE rs_wtb ( temp : ANYPTR ; val : CHAR ); SRC PROCEDURE rs_rdw ( temp : ANYPTR ; VAR x : io_word); SRC PROCEDURE rs_wtw ( temp : ANYPTR ;  - - - - - - T * queue_full - - - - - - - - - - T * inqueue - - G - - I - - - - G * outqueue - - G - - O - - - - G * init_queue - val : io_word); SRC PROCEDURE rs_rds ( temp : ANYPTR ; reg : io_word; SRC VAR x : io_word); SRC PROCEDURE rs_wtc ( temp : ANYPTR ; reg : io_word; SRC  - - - - - - - - - - * check_queue - - - - - - - - - - T * check_dsr_cts - - - - - - - - - - T * wait - - I - - - - G - L T * send  val : io_word ); SRC PROCEDURE rs_tfr ( temp : ANYPTR ; bcb : ANYPTR); SRC END; { of RS } PAGE ***************************************************************************** - - P - - - I L - L T * get_char - - L T - O P L - L L * wait_send - - L - - - I L - L L * wait_get - - P L - O L L - L L * * * * SYMBOLS FOR EXPORT AS PROCEDURE NAMES * ****************************************************************************** DEF RS_RS DEF RS_RS_INIT DEF RS_RS_ISR DEF RS_RS_RDB DEF RS_RS_WTB DEF RS_R check_error - - - - - - - - - - - * soft_reset* - - - - - - - - - T T * connect* - - - - - - - - - L L * disconnect - - - - - - - - -S_RDW DEF RS_RS_WTW DEF RS_RS_RDS DEF RS_RS_WTC DEF RS_RS_TFR ****************************************************************************** * * SYMBOLS FOR IMPORT * *************************************************** - - * rdivu - - - I O - - - - - - * check_xfer_in - - - - - - - - - - - * check_xfer_out - - - - - - - - - - - * clear_xfer+ - I - - - -      : not used by routine * * NOTE: the registers used by routines to do an ioescape have been * left out since they do not effect other routines. * * *This routine calls ABORT_IO which uses other registers not listed * +This heck_error, dump_buffer, set_xfer page * * * ROUTINE CALLED BY * ------- --------- * queue_space get_char, isr * queue_empty dump_buffer, rds (6, 10) * queue_full isr * inqueue routine calls LOGEOT which uses other registers not listed page * * ROUTINE USAGE SUMMARY * * ROUTINE CALLS * ------- ----- * queue_space * queue_empty * queue_full * inqueue * outqueue * init_queue * check_queue * check_dsr_cts * wait check_queue, check_dsr_cts (both indirectly) * send wait isr, wait_send, get_char * get_char rds(6), dump_buffer, wait_get * wait_send wtb, wtw * wait_get rdb, rdw, * check_error rdb, wtb, rdw, wtw, rds(6), wtc(6), tfr, * wait_send, wait_get, check_dsr_cts * get_char outqueue, queue_space, send * wait_send send, check_error * wait_get wait, check_error, get_char, check_queue * check_error ioescape * soft_reset init_queue, ABORT_IO *  * soft_reset wtc(14), connect * connect rdb, wtb, rdw, wtw, wtc(12), tfr * disconnect wtc(12) * rdivu rds(3), wtc(3) * check_xfer_in rdb, rdw, * check_xfer_out wtb, wtw * clear_xfer  connect soft_reset * disconnect * rdivu * check_xfer_in ioescape * check_xfer_out ioescape * clear_xfer * set_xfer * dump_buffer queue_empt isr, dump_buffer * set_xfer tfr * dump_buffer tfr, isr * ioescape rds, wtc, tfr, check_error, check_xfer_in, * check_xfer_out * ABORT_IO init, soft_reset * LOGEOT isy, get_char, clear_xfer, LOGEOT * ioescape * init init_queue, ABORT_IO * rdb connect, check_error, check_xfer_in, wait_get * wtb connect, check_error, check_xfer_out, wait_send * r, dump_buffer TTL RS232 DRIVERS page ***************************************************************************** * * module initialization -- none required. * ****************************************************************** rdw connect, check_error, check_xfer_in, wait_get * wtw connect, check_error, check_xfer_out, wait_send * rds queue_empty, get_char, check_error, rdivu, ioescape, * connect * wtc*********** RS_RS EQU * RTS ***************************************************************************** * * 98626 card register mnemonics * ***************************************************************************** RESET_REG  check_error, soft_reset, connect, disconnect, rdivu, * ioescape * isr queue_space, queue_full, inqueue, check_dsr_cts, * send, dump_buffer, LOGEOT * tfr connect, cEQU 1 write only ID_REG EQU 1 read only INTR_SW EQU 3 interrupt switches BAUD_SW EQU 5 baud rate switch bank LINE_SW EQU 7 line chara      EQU S_LINE+1 1 contains current handshake XON_CHAR EQU S_HANDSH+1 1 XOFF_CHAR EQU XON_CHAR+1 1 ENQ_CHAR EQU XOFF_CHAR+1 1 ACK_CHAR EQU ENQ_CHAR+1 1 CONV_CHAR EQU ACK************************** RS_RS_INIT EQU * * * Pascal interface overhead * MOVEA.L (SP)+,A0 * get return address MOVEA.L (SP)+,A2 * get temp address MOVEA.L C_ADR(A2),A1 * get card address PEA _CHAR+1 1 IGNORE_PE EQU CONV_CHAR+1 1 {aaa} *empty 1 {aaa} Q_DESCRIPT EQU IGNORE_PE+2 {aaa} Q_SIZE EQU Q_DESCRIPT 2 Q_IN EQU Q_DESCRIPT+2 2 Q_OUT (A0) * restore return address * * Assembler initialize entry point * ON ENTRY: A1 and A2 are set to card address and * temp space address (respectively) * ASM_INIT EQU * * * Stop transfers and Reset the cacteristic switches * * UART registers * DATA EQU 17 receive/transmit buffer (dlab=0) INTR_EN EQU 19 interrupt enable register(dlab=0) DIV0 EQU 17 divisor latch (LSB)  EQU Q_DESCRIPT+4 2 Q_BUFFER EQU Q_DESCRIPT+6 134 the rest is internal buffer {aaa} DEF_BAUD EQU Q_BUFFER+134 2 jws Note: stuck here for DEF_LINE EQU DEF_BAUD+2 1 jws code compatibility. *em (DLAB=1) DIV1 EQU 19 divisor latch (MSB) (DLAB=1) INTR_ID EQU 21 interrupt identification LINE_CONT EQU 23 line control register MODEM_CONT EQU 25 modem copty 1 jws * --- * 164 total space used {jws} ****************************************************************************** * * constantrol register LINE_STAT EQU 27 line status register MODEM_STAT EQU 29 modem status register page ****************************************************************************** * * ATTRIBUTnts (mnemonics) * ****************************************************************************** TEMP_SIZE EQU 160 BUFFER_SIZE EQU TEMP_SIZE-Q_BUFFER+AVAIL_OFF DC1 EQU 17 ASCII CHARACTER 17 DC3 EQE space offset mnemonics * (do not mix -- word boundary problems) * the word address is assumed to be EVEN * starting at AVAIL_OFF * ****************************************************************************** * U 19 ASCII CHARACTER 19 ENQ EQU 5 ASCII CHARACTER 5 ACK EQU 6 ASCII CHARACTER 6 UNDERSCORE EQU 95 ASCII CHARACTER 95 OVERRUN_ERROR EQU 314  size * ---- S_ERROR EQU AVAIL_OFF 4 pending error number IN_ISR EQU S_ERROR+4 1 XIN_ACT EQU IN_ISR+1 1 CONNECTED EQU XIN_ACT+1 1 receive buffer overflow error ACK_SIZE EQU 80 hysteresis for ENQ/ACK handshake XOFF_SIZE EQU 40 when to send XOFF XON_SIZE EQU BUFFER_SIZE-XOFF_SIZE REG_MAX EQU 22 maximum cMODEM_ON EQU CONNECTED+1 1 RECEIVING EQU MODEM_ON+1 1 XMITTING EQU RECEIVING+1 1 S_MODEM EQU XMITTING+1 1 modem status copy S_LINE EQU S_MODEM+1 1 line status copy S_HANDSH ontrol/status register number {aaa} TTL RS232 DRIVERS -- initialize page ***************************************************************************** * * driver initialization * ***************************************************     rd * JSR ABORT_IO * stop transfers * -- RESET CARD -- ST RESET_REG(A1) * write to reg 1 * * wait at least 25us * MOVE.L #40,-(SP) USE DELAY ROUTINE dew1 12/89 JSivisor table (for switches) jws-- not presently used * *BAUD DC.W 3072 * 50 Baud * DC.W 2048 * 75 * DC.W 1396 * 110 * DC.W 1142 * 134.5 * DC.W 1024 R DELAY_TIMER DELAY FOR 40us * * global attribute initialization * * -- init queue descriptors -- BSR INIT_QUEUE * -- init pseudo registers -- CLR.B XIN_* 150 * DC.W 768 * 200 * DC.W 512 * 300 * DC.W 256 * 600 * DC.W 128 * 1200 * DC.W 85 * 1800 * DC.W 64 * 2400 * ACT(A2) CLR.B IN_ISR(A2) CLR.L S_ERROR(A2) CLR.B S_MODEM(A2) CLR.B S_LINE(A2) CLR.B CONNECTED(A2) CLR.B MODEM_ON(A2) CLR.B IGNORE_PE(A2) {aaa} * DC.W 43 * 3600 * DC.W 32 * 4800 * DC.W 21 * 7200 * DC.W 16 * 9600 * DC.W 8 * 19200 TTL RS232 DRIVERS -- read byte page ******** -- set flags -- MOVE.B #1,RECEIVING(A2) MOVE.B #1,XMITTING(A2) * -- default characters -- MOVE.B #DC1,XON_CHAR(A2) MOVE.B #DC3,XOFF_CHAR(A2) MOVE.B #ENQ,ENQ_CHAR(A2) MO********************************************************************* * * read byte * ***************************************************************************** RS_RS_RDB EQU * * * Pascal interface overhead * MOVEA.L (SP)+,A0 VE.B #ACK,ACK_CHAR(A2) MOVE.B #UNDERSCORE,CONV_CHAR(A2) * * Set defaults from the switches (done after attribute initialization * just in case the card is not completely reset already) * * -- set get return address MOVEA.L (SP)+,A3 get VAR address MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) restore return  baud rate from DEF_BAUD -- * BSET #7,LINE_CONT(A1) * set DLAB to get to divisor latches MOVE.B DEF_BAUD(A2),DIV1(A1) jws MOVE.B DEF_BAUD+1(A2),DIV0(A1) jws * -- SET LINE CHARACTERISaddress * * Card overhead (any of the three can do an ioescape) * BSR CONNECT make sure the card is active BSR CHECK_ERROR check for errors saved by ISRs BSR CHECK_XFER_IN make surTICS -- jws MOVE.B DEF_LINE(A2),D0 * get handshake and line status defaults MOVE.B D0,D1 * ANDI.B #$3F,D0 * mask and set default line status MOVE.B D0,LINE_CONT(A1) * (also restores dlab) * e no input transfers active BSR WAIT_GET get character with wait MOVE.B D2,(A3) return the character RTS TTL RS232 DRIVERS -- write byte page ******************************** -- SAVE HANDSHAKE -- ANDI.B #$C0,D1 * handshake is top two bits LSR.B #5,D1 * adjust it (for jump tables) MOVE.B D1,S_HANDSH(A2) * save it RTS * * baud rate/d********************************************* * * write byte * ***************************************************************************** RS_RS_WTB EQU * * * Pascal interface overhead * MOVEA.L (SP)+,A0 get return       get second character MOVE.W D2,(A3) return the word RTS TTL RS232 DRIVERS -- write word page ***************************************************************************** * * write word * * TST.W D1 check for negative register number BLT.S STS_ERROR if so goto common ioescape routine CMP.W #REG_MAX,D1 check for too large register number BGT.S STS_ERROR **************************************************************************** RS_RS_WTW EQU * MOVEA.L (SP)+,A0 get return address MOVE.W (SP)+,D3 get word to be written MOVEA.L (SP)+,A2  CLR.W (A3) clear the top half of the return word ADDQ.L #1,A3 point a3 to lower half byte of return word LSL.W #1,D1 get ready for (word) table jump MOVE.W STS_TABLE(D1)address MOVE.B (SP)+,D3 get char to be written MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) restore return address * * Ca get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) restore return address * * Card overhead (any of the three can do an ioescape) * BSR CONNECT make sure thrd overhead * BSR CONNECT autoconnect BSR CHECK_ERROR check for errors found by ISRs BSR CHECK_XFER_OUT make sure no output transfers are active BSR WAIT_SEND e card is active BSR CHECK_ERROR check for errors saved by ISRs BSR CHECK_XFER_OUT make sure no output transfers are active ROR.W #8,D3 position the first character BSR W send the character RTS TTL RS232 DRIVERS -- read word page ***************************************************************************** * * read word * *****************************************************************AIT_SEND send it ROR.W #8,D3 position the second character BSR WAIT_SEND send it RTS TTL RS232 DRIVERS -- status page ***************************************************** RS_RS_RDW EQU * MOVEA.L (SP)+,A0 get return address MOVEA.L (SP)+,A3 get VAR address MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get car************************************ * * read status *---------------------------------------------------------------------------- * CONVENTION: A3 -- place to put the result (word sized) * *****************************************************d address PEA (A0) restore return address * * Card overhead (any of the three can do an ioescape) * BSR CONNECT make sure the card is active BSR CHECK_ERROR check for erro************************ RS_RS_RDS EQU * * * Pascal Interface Overhead * MOVEA.L (SP)+,A0 get return address MOVEA.L (SP)+,A3 get VAR address MOVE.W (SP)+,D1 get register numbers saved by ISRs BSR CHECK_XFER_IN make sure no input transfers are active BSR WAIT_GET get character with wait LSL.W #8,D2 shift first character BSR WAIT_GET r MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) restore return address * * Check for legal registers and jump to correct register handler *      ,D1 get offset from status table JMP STS_TABLE(D1) do the indexed jump STS_TABLE EQU * DC.W STS_0-STS_TABLE ID register DC.W STS_1-STS_TABLE Interrupt status register DC.W OVE.B INTR_SW(A1),(A3) get result from card RTS *----------------------------------------------------------------------------- STS_2 EQU * -- "Busy Bits" -- MOVE.B INTR_SW(A1),D7 --> interrupt e STS_2-STS_TABLE Busy bits register DC.W STS_3-STS_TABLE Baud rate DC.W STS_4-STS_TABLE Character control register DC.W STS_5-STS_TABLE Modem control register DC.W STS_6-STS_TABLE nabled bit (1) AND.B #$80,D7 LSR.B #6,D7 move it to correct position TST.L BUFI_OFF(A2) --> transfer active bit (0) BNE.S SET_BIT_0 TST.L BUFO_OFF(A2) BEQ.S DO_BIT_4  Data in register DC.W STS_7-STS_TABLE Optional circuits register DC.W STS_8-STS_TABLE Interrupt Enable Mask register DC.W STS_9-STS_TABLE Interrupt Cause register DC.W STS_10-STS_T neither transfer is active SET_BIT_0 EQU * set transfer active bit BSET #0,D7 DO_BIT_4 EQU * --> not transmitting bit (4) TST.B XMITTING(A2) BNE.S DO_BIT_5 ABLE UART Status register DC.W STS_11-STS_TABLE Modem Status register DC.W STS_12-STS_TABLE Connect/Disconnect register DC.W STS_13-STS_TABLE Hardware handshake register DC.W STS_14-ST BSET #4,D7 DO_BIT_5 EQU * --> not receiving bit (5) TST.B RECEIVING(A2) BNE.S END_STS_2 BSET #5,D7 END_STS_2 EQU * store away result MOVE.B D7,(A3) RS_TABLE Error status register DC.W STS_15-STS_TABLE Current Xon Character DC.W STS_16-STS_TABLE Current Xoff Character DC.W STS_17-STS_TABLE Current ENQ Character DC.W STS_18-STS_TABLETS *----------------------------------------------------------------------------- STS_3 EQU * -- Baud rate -- SUBQ.L #1,A3 this routine returns a word * * Get divisor (a critical section since it use Current ACK Character DC.W STS_19-STS_TABLE Current FE/PE convert Character DC.W STS_20-STS_TABLE Ignore FE/PE DC.W STS_21-STS_TABLE Default baud rate jws DC.W STS_22-STS_TABLE s DLAB) * MOVE.B INTR_SW(A1),D7 save card interrupt status CLR.B INTR_SW(A1) disable interrupts BSET #7,LINE_CONT(A1) get access to divisor latches MOVE.B DIV1(A1),D0 get upper Default line settings jws STS_ERROR EQU * MOVEQ #BAD_RDS,D0 BRA IOESCAPE error number is passed in d0 *----------------------------------------------------------------------------- STS_0 EQU *  half of divisor LSL.W #8,D0 MOVE.B DIV0(A1),D0 get lower half of divisor BCLR #7,LINE_CONT(A1) reset DLAB so normal operation can resume MOVE.B D7,INTR_SW(A1) restore interrupts * * Che -- ID register -- MOVE.B ID_REG(A1),(A3) get id from card RTS *----------------------------------------------------------------------------- STS_1 EQU * -- Interrupt Status -- Mck for special divisors which division is inexact * STS_3B TST.W D0 - infinite baud rate ? - BNE.S IS85 RTS return zero baud rate IS85 CMP.W #85,D0 - 1800 baud ?       CHECK_ERROR check for errors trapped by ISRs BSR QUEUE_EMPTY read from buffer if not empty BEQ.S READ_UART else read directly from UART MOVE.B INTR_SW(A1),D5 save interrupt MOVE.B D7,INTR_SW(A1) restore interrupts (end critical section) AND.B #$1E,D6 only use the read destructive bits OR.B LINE_STAT(A1),D6 combine it with the current status BSR QUEUE_EMPTY  state CLR.B INTR_SW(A1) disable card interrupts for critical section BSR GET_CHAR (get character with handshake) MOVE.B D2,(A3) MOVE.B D5,INTR_SW(A1) restore interrupt state  use internal buffer to determine bit 0 BEQ.S DONT_SET BSET #0,D6 set receive buffer full bit DONT_SET EQU * MOVE.B D6,(A3) RTS *------------------------------------------------------- BNE.S IS77 MOVE.W #1800,(A3) RTS IS77 CMP.W #77,D0 - 2000 baud ? - BNE.S IS43 MOVE.W #2000,(A3) RTS IS43 CMP.W #43,D0 - 3600 baud ? -  RTS READ_UART EQU * MOVE.B DATA(A1),(A3) RTS *----------------------------------------------------------------------------- STS_7 EQU * -- Optional circuits -- MOVEQ #0,D7 BNE.S IS21 MOVE.W #3600,(A3) RTS IS21 CMP.W #21,D0 - 7200 baud ? - BNE.S REGULAR MOVE.W #7200,(A3) RTS REGULAR EQU * * * Compute baud rate by: baud_rate = (freq/16) / RETURN 0 IF 98644 MOVE.B ID_REG(A1),D6 GET ID REG BCLR #7,D6 CLEAR REMOTE BIT CMP.B #66,D6 BRANCH IF 98644 BEQ.S STS_7B MOVE.B BAUD_SW(A1),D7 read from tdivisor * MOVE.L #153600,D1 BSR RDIVU do the division MOVE.W D1,(A3) store away the answer (d1) RTS *----------------------------------------------------------------------------- STS_4he card hardware LSR.B #4,D7 right justify (and get rid of baud info) STS_7B MOVE.B D7,(A3) RTS *----------------------------------------------------------------------------- STS_8 EQU * --  EQU * -- Character control -- MOVE.B LINE_CONT(A1),D7 get line control AND.B #$3F,D7 remove top two bits MOVE.B S_HANDSH(A2),D6 get handshake LSL.B #5,D6 interrupt enable mask -- MOVE.B INTR_EN(A1),(A3) read directly from the UART RTS *----------------------------------------------------------------------------- STS_9 EQU * -- interrupt cause -- MO move it to top two bits OR.B D6,D7 combine to form register result MOVE.B D7,(A3) RTS *----------------------------------------------------------------------------- STS_5 EQU * VE.B INTR_ID(A1),(A3) read directly from the UART RTS *----------------------------------------------------------------------------- STS_10 EQU * -- UART status -- MOVE.B INTR_SW(A1),D7 save card -- Modem control -- MOVE.B MODEM_CONT(A1),(A3) read directly from the UART RTS *----------------------------------------------------------------------------- STS_6 EQU * -- Data in -- BSR  interrupt condition CLR.B INTR_SW(A1) disable interrupts for critical section MOVE.B S_LINE(A2),D6 get accumulated line status CLR.B S_LINE(A2) reset it since it is read destructive      ----------------------- STS_11 EQU * -- modem status -- MOVE.B INTR_SW(A1),D7 save card interrupt condition CLR.B INTR_SW(A1) disable interrupts for critical section MOVE.B S_MODE--------------------------------------- STS_17 EQU * -- Current ENQ character -- MOVE.B ENQ_CHAR(A2),(A3) RTS *----------------------------------------------------------------------------- STS_18 EQU * M(A2),D6 get accumulated copy of modem status CLR.B S_MODEM(A2) clear it since it is read destructive MOVE.B D7,INTR_SW(A1) restore interrupts (end critical section) AND.B #$0F,D6  -- Current ACK character -- MOVE.B ACK_CHAR(A2),(A3) RTS *----------------------------------------------------------------------------- STS_19 EQU * -- Current FE/PE convert character --  only use the read destructive bits OR.B MODEM_STAT(A1),D6 combine it with the current status MOVE.B D6,(A3) RTS *----------------------------------------------------------------------------- STS_12 EQU * MOVE.B CONV_CHAR(A2),(A3) RTS *----------------------------------------------------------------------------- STS_20 EQU * -- Ignore FE/PE {aaa} MOVE.B IGNORE_PE(A2),(A3) {aaa} RTS  -- connect/disconnect -- MOVE.B CONNECTED(A2),(A3) get the pseudo-register RTS *----------------------------------------------------------------------------- STS_13 EQU * -- hardware handshake regi {aaa} TTL RS232 DRIVERS -- control page *----------------------------------------------------------------------------- STS_21 EQU * -- Default baud rate jws ster -- MOVE.B MODEM_ON(A2),(A3) RTS *----------------------------------------------------------------------------- STS_14 EQU * -- current error status -- MOVE.B INTR_SW(A1),D7 save interrupt s SUBQ.L #1,A3 return a word jws MOVE.W DEF_BAUD(A2),D0 get default divisor jws BRA STS_3B same as status 3 from hr jws *--------------------------------------------------tate CLR.B INTR_SW(A1) disable interrupts MOVE.W S_ERROR+2(A2),-1(A3) get (lower word of) the error * this is a word register! CLR.L S_ERROR(A2) the read is dest--------------------------- STS_22 EQU * -- Default line switch jws MOVE.B DEF_LINE(A2),(A3) jws RTS * **************************************************************************ructive MOVE.B D7,INTR_SW(A1) restore interrupt state RTS *----------------------------------------------------------------------------- STS_15 EQU * -- Current Xon character -- MOVE.B XON_CHAR*** * * write control *---------------------------------------------------------------------------- * CONVENTION: D0.W -- value of the control * ***************************************************************************** RS_RS_WTC EQU(A2),(A3) RTS *----------------------------------------------------------------------------- STS_16 EQU * -- Current Xoff character -- MOVE.B XOFF_CHAR(A2),(A3) RTS *-------------------------------------- * * * Pascal Interface Overhead * MOVEA.L (SP)+,A0 get return address MOVE.W (SP)+,D0 get value MOVE.W (SP)+,D1 get register number MOVEA.L (SP)+,A2 get temp      CONT_14-CONT_TABLE Soft reset register DC.W CONT_15-CONT_TABLE Redefine Xon Character DC.W CONT_16-CONT_TABLE Redefine Xoff Character DC.W CONT_17-CONT_TABLE Redefine ENQ Character DC.W CONT_word * length baud rate) * CMP.W #5,D0 5 is the lowest baud rate possible BGE.S CALC_DIV MOVEQ #IO_MISC,D0 value out of range -- io misc error BRA IOESCAPE * * calculate divisor 18-CONT_TABLE Redefine ACK Character DC.W CONT_19-CONT_TABLE Redefine FE/PE convert Character DC.W CONT_20-CONT_TABLE Ignore FE/PE {aaa} DC.W CONT_21-CONT_TABLE Set default baud rate DC.W CONT: div = (freq/16) / baud_rate * CALC_DIV EQU * MOVE.L #153600,D1 d1 := freq/16 BSR RDIVU d1.w := d1.l / d0.w ( freq/16 / baud ) * * move the divisor to hardware (critical section: uses DLAB) *  address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) restore return address * * Check for legal registers and jump to correct register handler * TST.W D1 check for nega_22-CONT_TABLE Set default line control CONT_ERROR EQU * MOVEQ #BAD_RDS,D0 BRA IOESCAPE error number is passed in d0 *----------------------------------------------------------------------------- CONT_0 tive register number BMI.S CONT_ERROR if so goto common ioescape routine CMP.W #REG_MAX,D1 check for too large register number BGT.S CONT_ERROR LSL.W #1,D1 get ready for (w EQU * -- reset -- TST.W D0 BNE ASM_INIT initialize if any bit is set RTS *----------------------------------------------------------------------------- CONT_1 EQU * ord) table jump MOVE.W CONT_TABLE(D1),D1 get offset from status table JMP CONT_TABLE(D1) do the indexed jump CONT_TABLE EQU * DC.W CONT_0-CONT_TABLE Reset DC.W CONT_1-CONT_TABLE B -- send break -- TST.W D0 BEQ.S EXIT_C1 no-op if control value is zero * * set and hold break for 400ms * BSET #6,LINE_CONT(A1) set the break bit in UART MOVE.L #400000,-(SP) USreak DC.W CONT_ERROR-CONT_TABLE Register 2 Undefined DC.W CONT_3-CONT_TABLE Baud rate DC.W CONT_4-CONT_TABLE Character control register DC.W CONT_5-CONT_TABLE Modem control register DCE DELAY ROUTINE ttt JS 8/3/83 WAIT_BREAK EQU * JSR DELAY_TIMER CALL DELAY ROUTINE ttt JS 8/3/83 * * release break and wait 60ms for break to clear * BCLR #6,LINE_CONT(A1) clear the break bit in UART .W CONT_6-CONT_TABLE Data out register DC.W CONT_7-CONT_TABLE Optional circuits register DC.W CONT_ERROR-CONT_TABLE Register 8 Undefined DC.W CONT_ERROR-CONT_TABLE Register 9 Undefined DC.W CON MOVE.L #60000,-(SP) SETUP FOR DELAY ROUTINE ttt JS 8/3/83 WAIT_BREAK2 EQU * JSR DELAY_TIMER CALL DELAY ROUTINE ttt JS 8/3/83 EXIT_C1 RTS *------------------------------------------------------------------T_ERROR-CONT_TABLE Register 10 Undefined DC.W CONT_ERROR-CONT_TABLE Register 11 Undefined DC.W CONT_12-CONT_TABLE Connect/Disconnect register DC.W CONT_13-CONT_TABLE Hardware handshake register DC.W ----------- CONT_3 EQU * -- Baud rate -- * * check for overflow -- a baud rate with a resulting divisor more than * sixteen bits long. * (underflow is not checked because it cannot be generated with a       MOVE.B INTR_SW(A1),D7 save card interrupt state CLR.B INTR_SW(A1) disable card interrupts BSET #7,LINE_CONT(A1) set DLAB to get access to divisor latches MOVE.B D1,DIV0(A1) set  -- Optional Circuits -- MOVE.B ID_REG(A1),D6 GET ID REG BCLR #7,D6 CLEAR REMOTE BIT CMP.B #66,D6 IS THIS A 98644 ? BEQ.S CONT_7R YES, NO OP lower half of divisor latch LSR.W #8,D1 MOVE.B D1,DIV1(A1) set upper half of divisor latch BCLR #7,LINE_CONT(A1) clear DLAB for normal use MOVE.B D7,INTR_SW(A1) restore card interrupt stat LSL.B #4,D0 left justify MOVE.B D0,BAUD_SW(A1) write directly to card hardware CONT_7R RTS *----------------------------------------------------------------------------- CONT_12 EQU * --e RTS *----------------------------------------------------------------------------- CONT_4 EQU * -- Character Control -- MOVE.B D0,D7 save a copy of control value AND.B #$3F,D0  connect/disconnect -- TST.B D0 check for d0=0 BEQ DISCONNECT disconnect will do return CMP.B #1,D0 BEQ CONNECT connect will return VAL_ERR EQU *  use only bottom 6 bits MOVE.B D0,LINE_CONT(A1) for line control AND.B #$C0,D7 handshake is top two bits LSR.B #5,D7 shift it for later use CMP.B S_HANDSH(A2),D7 MOVEQ #IO_MISC,D0 illegal value for register BRA IOESCAPE *----------------------------------------------------------------------------- CONT_13 EQU * -- hardware handshake -- TST.B D0  if handshake changed BEQ.S EXIT_C4 MOVE.B INTR_SW(A1),D6 save interrupt state CLR.B INTR_SW(A1) disable interrupts MOVE.B D7,S_HANDSH(A2) save new handshake MOVE.B #1,RECEI check for too small value BLT.S VAL_ERR (located in cont_12) CMP.B #1,D0 check for too large value BGT.S VAL_ERR MOVE.B D0,MODEM_ON(A2) assign modem flag RVING(A2) \ MOVE.B #1,XMITTING(A2) / reset the handshake flags MOVE.B D6,INTR_SW(A1) restore interrupt state EXIT_C4 RTS *----------------------------------------------------------------------------- CONT_5 TS *----------------------------------------------------------------------------- CONT_14 EQU * -- soft reset -- TST.W D0 any bit will do reset BEQ.S EXIT_14 zero value does EQU * -- modem control -- MOVE.B D0,MODEM_CONT(A1) write directly to UART RTS *----------------------------------------------------------------------------- CONT_6 EQU * -- Data out -- nothing BSR SOFT_RESET EXIT_14 RTS *----------------------------------------------------------------------------- CONT_15 EQU * -- redefine Xon character -- MOVE.B D0,XON_CHAR(A2) RTS *-------------- BSR CHECK_ERROR check for errors trapped by ISRs MOVE.B D0,DATA(A1) write directly to UART RTS *----------------------------------------------------------------------------- CONT_7 EQU * --------------------------------------------------------------- CONT_16 EQU * -- redefine Xoff character -- MOVE.B D0,XOFF_CHAR(A2) RTS *----------------------------------------------------------------------------      BGE.S CALC_DIV21 if ok then skip {jws} MOVEQ #IO_MISC,D0 else give error {jws} BRA IOESCAPE {jws} CALC_DIV21 EQU * _TABLE output empty interrupt DC.W INPUT_INTR-INTR_TABLE input available interrupt DC.W ERROR_INTR-INTR_TABLE error interrupt page * * Check for possible unexpected interrupts, if found clear the interrup {jws} MOVE.L #153600,D1 calculate divisor {jws} BSR RDIVU same as CONT_3 {jws} MOVE D1,DEF_BAUD(A2) save divisor as DEF_BAUD {jws} RTSt * (different for each type of interrupt) and disable that type of * interrupt. ERROR_INTR EQU * MOVE.B LINE_STAT(A1),D0 clear the interrupt (by reading line status) OR.B D0,S_LINE(A2) save line status - CONT_17 EQU * -- redefine ENQ character -- MOVE.B D0,ENQ_CHAR(A2) RTS *----------------------------------------------------------------------------- CONT_18 EQU * -- redefine ACK charac *---------------------------------------------------------------------------- CONT_22 EQU * -- Set default line sw. {jws} MOVE.B D0,DEF_LINE(A2) {jws} RTS ter -- MOVE.B D0,ACK_CHAR(A2) RTS *----------------------------------------------------------------------------- CONT_19 EQU * -- redefine FE/PE convert character -- MOVE.B D0,CONV_CHAR(A2) RTS *- {jws} TTL RS232 DRIVERS -- interrupt service routines page ***************************************************************************** * * interrupt service routine * ***************************---------------------------------------------------------------------------- CONT_20 EQU * -- Ignore PE/FE -- {aaa} TST.B D0 check for too small value {aaa} BLT.S VAL_ERR2 ************************************************** RS_RS_ISR EQU * * * pascal interface overhead * MOVEA.L (SP)+,A0 get return address MOVEA.L (SP)+,A2 get temp address MOVEA.L C_ADR(A2), {aaa} CMP.B #1,D0 check for too large value {aaa} BGT.S VAL_ERR2 {aaa} MOVE.B D0,IGNORE_PE(A2) assign modem flag {aaa} A1 get card address PEA (A0) restore return address * * verify there is an interrupt * MOVE.B INTR_ID(A1),D0 get interrupt cause BTST #0,D0 make sure an interr RTS {aaa} VAL_ERR2 EQU * {aaa} MOVEQ #IO_MISC,D0 illegal value for register{aaa} BRA IOESCAPE upt is pending BEQ.S INTR_EXIST RTS no interrupt-- return * * jump to appropriate interrupt handler * INTR_EXIST EQU * MOVE.B #1,IN_ISR(A2) mark isr processing EXT.W D0 {aaa} *----------------------------------------------------------------------------- CONT_21 EQU * -- Set default baud rate {jws} CMP.W #5,D0 check for overflow {jws}  MOVE.W INTR_TABLE(D0),D0 (get appropriate address) JMP INTR_TABLE(D0) (jump to the proper case) INTR_TABLE EQU * DC.W MODEM_INTR-INTR_TABLE modem change interrupt DC.W OUTPUT_INTR-INTR     for user BCLR #2,INTR_EN(A1) disable interrupts since it should not happen BRA END_ISR MODEM_INTR EQU * TST.B MODEM_ON(A2) modem handshake on? BEQ.S ABORT_MODEM -- no abortST.B MODEM_ON(A2) modem handshake on ? BEQ.S CLR_XOUT ANDI.B #$F5,INTR_EN(A1) disable output and modem interrupts LOOP_LAST EQU * MOVE.B LINE_STAT(A1),D7 wait for everything transferred O MOVE.L BUFO_OFF(A2),D7 output transfer active? BNE.S XFER_OUT -- yes do transfer ABORT_MODEM EQU * MOVE.B MODEM_STAT(A1),D0 clear the interrupt (by reading modem status) OR.B D0,SR.B D7,S_LINE(A2) before dropping RTS NOT.B D7 AND.B #$60,D7 BNE.S LOOP_LAST BCLR #1,MODEM_CONT(A1) drop RTS is the EOI condition BSR CLEAR_XFER clear the transfer _MODEM(A2) save modem status for user BCLR #3,INTR_EN(A1) disable interrupt so it won't happen again BRA END_ISR OUTPUT_INTR EQU * MOVE.L BUFO_OFF(A2),D7 output interrupt transfer active ?  JSR LOGEOT call the eot procedure BRA END_ISR CLR_XOUT EQU * ANDI.B #$F5,INTR_EN(A1) disable output and modem interrupts BSR CLEAR_XFER clear the transfer JSR L BNE.S XFER_OUT -- yes do transfer BCLR #1,INTR_EN(A1) -- no disable interrupt BRA END_ISR page * * Do the output interrupt transfer * (but only if the THRE and the modem lines are hiOGEOT call the eot procedure BRA END_ISR page * * Input interrupts are normally active in order to fill the internal * buffer * INPUT_INTR EQU * MOVE.B LINE_STAT(A1),D1 MOVE.B DATA(A1),D2 gh) * XFER_OUT EQU * MOVEA.L D7,A3 a3 := buffer control block MOVE.B LINE_STAT(A1),D7 check for THRE OR.B D7,S_LINE(A2) save line status for user BTST #5,D7 BEQ E get the input byte (clears interrupt) OR.B D1,S_LINE(A2) preserve line status for user TST.B MODEM_ON(A2) BEQ.S CHECK_BREAK skip modem stuff if handshake off * * check for both CD and DSR ND_ISR TST.B MODEM_ON(A2) BEQ.S MOVE_OUT BSR CHECK_DSR_CTS BNE END_ISR MOVE_OUT EQU * CLR.W D7 clear d7.w MOVEA.L TEMP_OFF(A3),A0 a0 := buffer empty pointer* MOVE.B MODEM_STAT(A1),D0 OR.B D0,S_MODEM(A2) preserve modem status for user NOT D0 ANDI #$A0,D0 mask appropriate bits BNE INPUT_END if zero then they were set p MOVE.B (A0)+,D7 d7 := character MOVE.B D7,DATA(A1) write the character MOVE.L A0,TEMP_OFF(A3) update empty pointer SUBQ.L #1,TCNT_OFF(A3) decrement the count BLE.S Ereviously * * ignore character if break received * CHECK_BREAK EQU * BTST #4,D1 if break received, BNE INPUT_END then ignore character * * convert Framing and Parity errors to specified charactND_XOUT count=0, transfer ends CMP.W TCHR_OFF(A3),D7 character = term. char ? BNE END_ISR END_XOUT EQU * TST.B TEND_OFF(A3) end condition enabled ? BEQ.S CLR_XOUT Ter * MOVE.B D1,D0 save line status for later use ANDI #$0C,D0 check for PARITY and FRAMING errors BEQ.S NO_CONVERT TST.B IGNORE_PE(A2) {aaa} BNE.S NO_CONVERT      P.W #XOFF_SIZE,D3 BGE.S PUTINQ * * Have to turn receiving off * MOVE.B XOFF_CHAR(A2),D3 prepare to send Xoff BSR SEND send character BNE.S PUTINQ send did not succeed *********************** RS_RS_TFR EQU * * * Pascal interface overhead * MOVEA.L (SP)+,A0 get return address MOVEA.L (SP)+,A3 get buffer control block address MOVEA.L (SP)+,A2 ge CLR.B RECEIVING(A2) no longer expecting input BRA.S PUTINQ but put present char in queue page ENQ_HAND EQU * CMP.B ENQ_CHAR(A2),D2 IF char <> ENQ BNE PUTINQ t temp address MOVEA.L C_ADR(A2),A1 get card address PEA (A0) restore return address * * Card overhead * BSR CONNECT BSR CHECK_ERROR * * Check for unsupported transfer modes *  {aaa} MOVE.B CONV_CHAR(A2),D2 convert the character NO_CONVERT EQU * * * jump to appropriate handshake handler * MOVE.B S_HANDSH(A2),D0 EXT.W D0 MOVE.W HAND_TABLE(D0),D0 get address to  THEN put char in queue BSR QUEUE_SPACE ELSE CMP.W #ACK_SIZE,D3 IF queue_space <= 80 BGE.S SEND_ACK CLR.B RECEIVING(A2) receiving := false BRA jump JMP HAND_TABLE(D0) HAND_TABLE EQU * DC.W ENQ_HAND-HAND_TABLE DC.W XON_HAND-HAND_TABLE DC.W NO_HAND-HAND_TABLE DC.W NO_HAND-HAND_TABLE page XON_HAND EQU * * * Do host part o INPUT_END SEND_ACK EQU * MOVE.B ACK_CHAR(A2),D3 set up parameter in D3 BSR SEND send ACK BEQ INPUT_END CLR.B RECEIVING(A2) not receiving since ACK not sent f the handshake -- check for Xon and Xoff * CMP.B XON_CHAR(A2),D2 BNE.S CHECK_XOFF MOVE.B #1,XMITTING(A2) turn transmitting back on TST.L BUFO_OFF(A2) \ BEQ INPUT_END \ BRA INPUT_END * * Put character (d2) in queue, and check for overrun. * NO_HAND EQU * PUTINQ EQU * BSR QUEUE_FULL IF queue_full BEQ.S OVERRUN THEN overrun_error BSR INQUEUE  BSET #1,INTR_EN(A1) \ enable interrupts if output TST.B MODEM_ON(A2) / transfer is active BEQ INPUT_END / BSET #3,INTR_EN(A1) / BRA INPUT_END CHECK_XO ELSE inqueue(char) INPUT_END EQU * ANDI #$02,D1 check for overrun error BEQ.S CHECK_XIN OVERRUN EQU * MOVE.L #OVERRUN_ERROR,S_ERROR(A2) * * If transfer in is active then do the transfer * CHECK_XINFF EQU * CMP.B XOFF_CHAR(A2),D2 BNE.S TERM_HAND CLR.B XMITTING(A2) turn transmitting off MOVE.B #$1,INTR_EN(A1) turn any possible output interrupts off BRA INPUT_END * * Do term EQU * TST.B XIN_ACT(A2) check for transfer active BEQ.S END_ISR MOVEA.L BUFI_OFF(A2),A3 a3 := buffer control block pointer BSR DUMP_BUFFER END_ISR EQU * CLR.B IN_ISR(A2)inal part of the handshake * TERM_HAND EQU * TST.B RECEIVING(A2) if receiving is on, might have BEQ.S PUTINQ to turn it off BSR QUEUE_SPACE d3 := space left in queue CM not in isr any longer RTS TTL RS232 DRIVERS -- transfer page ***************************************************************************** * * transfer * ******************************************************      ( done by table jump also ) * TST.B T_BW_OFF(A3) word mode? BNE.S WORD_ERR -- is unsupported MOVE.B TUSR_OFF(A3),D1 d1.w := offset into transfer table EXT.W D1 ADD.W Q.S EXIT_TFR if transfer done, then exit CLR.B INTR_SW(A1) disable interrupts for critical section MOVE.B #1,XIN_ACT(A2) BSR SET_XFER set interface busy BSR DUMP_BUFFERD1,D1 d1.w := word offset into table MOVE.W XFER_TABLE(D1),D1 JMP XFER_TABLE(D1) XFER_TABLE EQU * DC.W XFER_ERR-XFER_TABLE not used DC.W DMA_ERR-XFER_TABLE serial DMA -- not suppor make sure that buffer is empty (prevent deadlock) * if eot the following code will exit * so no explicit exit is done BSET #7,INTR_SW(A1) end of crted DC.W SER_FHS-XFER_TABLE serial FHS DC.W SER_FHS-XFER_TABLE serial fastest -- same as serial FHS DC.W XFER_ERR-XFER_TABLE not used DC.W INTR_XFER-XFER_TABLE overlap INTR DC.W DMA_Eitical section BRA.S CHECK_FHS end of input transfer setup page * * Output transfer setup * OUTPUT_XFER EQU * CLR.B INTR_SW(A1) disable interrupts for critical section BSR SET_XFERRR-XFER_TABLE overlap DMA -- not supported DC.W XFER_ERR-XFER_TABLE overlap FHS -- not supported DC.W INTR_XFER-XFER_TABLE overlap FASTEST -- same as overlap INTR DC.W INTR_XFER-XFER_TABLE overlap overlap --  set interface busy BSET #1,MODEM_CONT(A1) set RTS TST.B XMITTING(A2) if not transmitting, don't enable interrupts BEQ.S CHECK_FHS BSET #1,INTR_EN(A1) enable output interrupsame as overlap INTR page * * Error escapes * END_ERR EQU * DMA_ERR EQU * XFER_ERR EQU * BSR CLEAR_XFER MOVEQ #TFR_ERR,D0 BRA IOESCAPE WORD_ERR EQU * BSR CLEAR_XFER ts TST.B MODEM_ON(A2) if modem handshake BEQ.S CHECK_FHS BSET #3,INTR_EN(A1) enable modem interrupts * * IF serial transfer THEN wait until transfer is done * CHECK_FHS EQU * BSET #7,IN MOVEQ #NO_WORD,D0 BRA IOESCAPE * * Set the actual mode for transfers * SER_FHS EQU * MOVE.B #TT_FHS,TACT_OFF(A3) set the actual mode TST.B TDIR_OFF(A3) jump to correct direction handler TR_SW(A1) end of critical section CMPI.B #TT_FHS,TACT_OFF(A3) BNE.S EXIT_TFR WAIT_FHS EQU * CMPI.B #255,T_SC_OFF(A3) wait until buffer is not busy BNE.S WAIT_FHS EXIT_TFR EQU * RTSBNE.S OUTPUT_XFER BRA.S INPUT_XFER INTR_XFER EQU * MOVE.B #TT_INT,TACT_OFF(A3) set actual mode to INTR TST.B TDIR_OFF(A3) jump to correct direction handler BNE.S OUTPUT_XFER * BRA.S INPU TTL RS232 DRIVERS -- transfer support routines page ****************************************************************************** * * TRANSFER SUPPORT ROUTINES * ******************************************************************T_XFER * * Input transfer setup. * INPUT_XFER EQU * TST.B TEND_OFF(A3) end condition not allowed on input xfers BNE.S END_ERR BSR DUMP_BUFFER do most of transfers with intr enabled BE************ * * DUMP BUFFER * transfer from the internal queue to user queue * * ON ENTRY: a3 - points to buffer control block * ON EXIT : IF transfer was completed * THEN d2.L=0 and Z=1 * E     lear actual transfer mode MOVE.B #255,T_SC_OFF(A3) set the buffer not busy TST.B TDIR_OFF(A3) BNE.S CLEAR_OUT CLR.L BUFI_OFF(A2) clear input transfer RTS CLEAR_OUT EQU * CLR.L 0 * get select code of card MOVE.L D0,IOE_SC(A5) * put ioe_sc MOVE.W #IOE_ERROR,ESC_CODE(A5) * escapecode := ioe_error TRAP #10 * do Pascal escape *---------------------------------BUFO_OFF(A2) clear output transfer RTS *----------------------------------------------------------------------------- * SET_XFER * make a transfer active (link temp space with buffer control block) * ON ENTRY: a3 -------------------------------------------- * RDIVU * unsigned integer divide rounded. * ON ENTRY: d0.w -- divisor (unchanged by this routine) * d1.l -- dividend * ON EXIT: d1.w -- rounded quotient *-LSE d2.L=1 and Z=0 * USES: a0 - current fill pointer to user input buffer * d2 - character being transfered *----------------------------------------------------------------------------- DUMP_BUFFER EQU * MOVEA.L TFIL the buffer control block *----------------------------------------------------------------------------- SET_XFER EQU * MOVE.B IO_SC(A2),T_SC_OFF(A3) set the buffer busy TST.B TDIR_OFF(A3) BNE.S SET_OUT MOVE.L _OFF(A3),A0 get fill pointer CLR.W D2 clear top half of D2 (for later compares) DUMP_LOOP EQU * BSR QUEUE_EMPTY BEQ.S EXIT_DUMP BSR GET_CHAR d2 := character  A3,BUFI_OFF(A2) set sc's input active RTS SET_OUT EQU * MOVE.L A3,BUFO_OFF(A2) set sc's output active RTS *----------------------------------------------------------------------------- * CHECK_XFER_I MOVE.B D2,(A0)+ put it in the linear buffer SUBQ.L #1,TCNT_OFF(A3) decrement count BLE.S END_XIN CMP.W TCHR_OFF(A3),D2 BNE.S DUMP_LOOP END_XIN EQU * MOVE.L A0,TFIL_OFF(A3)N, CHECK_XFER_OUT * gives an error if a transfer is active * USES: d0 -- only if an ioescape is to be given *----------------------------------------------------------------------------- CHECK_XFER_IN EQU * TST.L BUFI_OFF(A2)  update fill pointer CLR.B XIN_ACT(A2) BSR CLEAR_XFER JSR LOGEOT CLR.L D2 set Z flag to mark transfer ended RTS EXIT_DUMP EQU * MOVE.L A0,TFIL_OFF(A3)  BNE.S BUSY_ERR RTS CHECK_XFER_OUT EQU * TST.L BUFO_OFF(A2) BNE.S BUSY_ERR RTS BUSY_ERR EQU * MOVEQ #SC_BUSY,D0 BRA IOESCAPE TTL RS232 DRIVERS -- common utilities  update fill pointer MOVEQ #1,D2 clear Z flage to mark transfer still active RTS page *----------------------------------------------------------------------------- * CLEAR_XFER * make a transfer  page ***************************************************************************** * * Useful Subroutines * ***************************************************************************** * * IOESCAPE * ON ENTRY: d0.L -- contains theinactive (unlink temp space and buffer control block) * ON ENTRY: a3 - points to the buffer control block *----------------------------------------------------------------------------- CLEAR_XFER EQU * CLR.B TACT_OFF(A3) c escape code *---------------------------------------------------------------------------- IOESCAPE EQU * MOVE.L D0,IOE_RSLT(A5) * put ioe_result CLR.L D0 *<<< BUG FIX >>> MOVE.B IO_SC(A2),D     --------------------------------------------------------------------------- RDIVU EQU * DIVU D0,D1 do truncated division SWAP D1 get access to remainder LSL.W #1,D1  page *----------------------------------------------------------------------------- * SOFT_RESET * initialize the "dynamic" attributes of the drivers * * uses : d6,d7 as temporary *-------------------------------------------- multiply remainder by 2 BCS.S ROUND if carry then remainder*2>divisor CMP.W D1,D0 remainder*2 > divisor ? BLE.S ROUND round up if so. * --------------------------------- SOFT_RESET EQU * JSR ABORT_IO abort transfers MOVE.B INTR_SW(A1),D6 save interrupt state CLR.B INTR_SW(A1) disable interrupts ANDI.B #1,I --do not round -- SWAP D1 get quotient RTS ROUND EQU * --round up-- SWAP D1 get old quotient ADDQ.W #1,D1 increment (doNTR_EN(A1) disable modem and transmit interrupts BSR INIT_QUEUE MOVE.B DATA(A1),D7 destroy any data CLR.B S_LINE(A2) MOVE.B LINE_STAT(A1),D7 reset the line status (destructive read)  the rounding) RTS page *---------------------------------------------------------------------------- * CONNECT * connects the card if not connected already. * * uses : d6,d7 by called routines *------------------------ CLR.B S_MODEM(A2) MOVE.B MODEM_STAT(A1),D7 reset the modem status (destructive read) CLR.L S_ERROR(A2) MOVE.B #1,RECEIVING(A2) MOVE.B #1,XMITTING(A2) MOVE.B D6,INTR_SW(A1) restore the inte---------------------------------------------------- CONNECT EQU * TST.B CONNECTED(A2) IF connected THEN do nothing BNE.S EXIT_CONNECT BSET #0,MODEM_CONT(A1) set DTR BSR SOFT_RESET rrupt state RTS *---------------------------------------------------------------------------- * CHECK_ERROR * check for errors recorded in interrupt service routines (ISRs) * USES: D0,D7 only if doing ioescape *---------- initialize the dynamic data MOVE.B #1,INTR_EN(A1) enable receive interrupts MOVE.B #1,CONNECTED(A2) set connected BSET #7,INTR_SW(A1) enable card interrupts EXIT_CONNECT EQU * RTS *------------------------------------------------------------------- CHECK_ERROR EQU * TST.L S_ERROR(A2) is error present BNE.S ERROR_EXIST RTS return if not error ERROR_EXIST EQU *---------------------------------------------------------------------------- * DISCONNECT * disconnect and disable interrupts *----------------------------------------------------------------------------- DISCONNECT EQU * BCLR  MOVE.B INTR_SW(A1),D7 save interrupt condition CLR.B INTR_SW(A1) disable interrupt for critical section MOVE.L S_ERROR(A2),D0 get error CLR.L S_ERROR(A2) clear errors  #7,INTR_SW(A1) disable card interrupts CLR.B CONNECTED(A2) set disconnected ANDI.B #$FC,MODEM_CONT(A1) drop DTR and RTS NOP CLR.B INTR_EN(A1) disable all UART interrupts RTS MOVE.B D7,INTR_SW(A1) restore interrupts BRA IOESCAPE do pascal escape page *----------------------------------------------------------------------------- * WAIT_SEND * This routine waits for th      page *----------------------------------------------------------------------------- * GET_CHAR * get a character with software handshake. * ON ENTRY : the queue is not empty! * ON EXIT: D2.B contains the character * * send handshake character (in D3) MOVE.B #1,INTR_EN(A1) only have receive interrupt enabled BSR SEND send char which is in d2 BNE.S RESTORE MOVE.B #1,RECEIVING(A2)  (the rest of D2 is not altered!) * USES: D3 -- space left in queue/temporary for character * D0.W -- handshake type & temporary * A4,D4,D6,D7 -- temporary *---------------------------------------------- turn receiving back on RESTORE EQU * recalculate interrupt enable mask MOVE.B INTR_SW(A1),D7 save interrupt status CLR.B INTR_SW(A1) critical section TST.L BUFO_OFF(A2) Be transmitting flag then sends * a character. It escapes if SEND returns with an error. * NOTE: this routine cannot be called by ISRs!!! * ON ENTRY: d3.B -- character to be sent * USES : a4 -- used by called routines * ------------------------------- GET_CHAR EQU * * * Read the character ( and pass it back ) * BSR OUTQUEUE get the character (into D2) * * Check for and do handshake overhead * TST.B RECEIVING(A2)  d4,d6,d7 -- by called routines *----------------------------------------------------------------------------- WAIT_SEND EQU * * * Wait for xmitting flag (no timeouts !!) * (the wait is important for Xon/Xoff as host) *  if receiving BNE.S READ_END then no overhead needed * * Jump to appropriate handshake handler * MOVE.B S_HANDSH(A2),D0 get handshake EXT.W D0 MOVE.W H_TABLE(D0),D0 JMP H_TABLE(D0)  TST.B XMITTING(A2) BEQ.S WAIT_SEND * * Send the character * OK_XMIT EQU * BSR SEND send character with timeout BSR CHECK_ERROR check for errors found by send RTS *----- H_TABLE EQU * DC.W ENQ_H-H_TABLE DC.W XON_H-H_TABLE DC.W READ_END-H_TABLE no handshake (no overhead) DC.W READ_END-H_TABLE no handshake page * * ENQ/ACK handshake--send ACK if que------------------------------------------------------------------------ * WAIT_GET * wait until the queue is empty before getting a character * ON EXIT: D2.B contains the character * (the rest of D2 is not altered!) *ue can handle more than 80 chars * ENQ_H EQU * BSR QUEUE_SPACE returns space left in D3 CMP.W #ACK_SIZE,D3 BLT.S READ_END space not big enough to send ACK * * Send character to indicate USES: A4.L -- parameter to WAIT * D0,D3,D4,D6,D7 -- used by called routines *----------------------------------------------------------------------------- WAIT_GET EQU * * * Wait (with timeout) for queue not empty *  card is receiving and set receiving flag * MOVE.B ACK_CHAR(A2),D3 send ack BRA.S SEND_HAND * * Xon/Xoff handshake--send Xon if queue can handle more characters * XON_H EQU * BSR QUEUE_SPACE d LEA CHECK_QUEUE,A4 \ call wait with the not queue empty BSR WAIT / function BSR CHECK_ERROR check for wait error BSR GET_CHAR BSR CHECK_ERROR RTS 3 := space left in queue CMP.W #XON_SIZE,D3 BLT.S READ_END space not big enough to send XON * * Send character to indicate card is receiving and set receiving flag * MOVE.B XON_CHAR(A2),D3 SEND_HAND EQU      EQ.S END_RESTORE TST.B XMITTING(A2) BEQ.S END_RESTORE BSET #1,INTR_EN(A1) TST.B MODEM_ON(A2) BEQ.S END_RESTORE BSET #3,INTR_EN(A1) END_RESTORE EQU * MOVE.B D7,INTR_SW(A1)  indicate no errors (Z := 1) RTS page *----------------------------------------------------------------------------- * WAIT * this function waits with timeout for a condition to happen, * if the condition does not h end critical section READ_END EQU * RTS page *----------------------------------------------------------------------------- * SEND * ON ENTRY: d3.B -- character to be sent * ON EXIT : IF character sent * appen within the timeout, then * S_ERROR(A2) is marked with the timeout error. * ON ENTRY: A4.L points to the routine which will determine if * the condition is met. This routine should have *  THEN Z=1 * ELSE Z=0, S_ERROR updated to newest error * USES : a4 -- parameter to WAIT * d7 -- temporary * d6 -- by called routines *-------------------------------------------------- the following conditions: * --uses at the most d7,d6 * --returns Z=1 if the condition is met * --all routines should have similar timing * ON EXIT: IF error is found * --------------------------- SEND EQU * BSET #1,MODEM_CONT(A1) set RTS * * Wait (with timeout) for transmit registers empty * LOOP_THRE EQU * MOVE.B LINE_STAT(A1),D7 OR.B D7,S_LINE(A2) save  THEN Z=0, S_ERROR indicates the error * ELSE Z=1 * USES : D4.L -- timeout counter * D7,D6 -- can be used by called routine (see above) *--------------------------------------------------line status for user AND.B #$20,D7 look at THRE bit BEQ.S LOOP_THRE TST.B MODEM_ON(A2) skip modem stuff if modem handshake off BEQ.S XMIT_CHAR * * Modem checking depends on if this routi--------------------------- WAIT EQU * JSR (A4) check the condition BEQ.S EXIT_WAIT exit if condition met (Z=1) MOVE.L TIMEOUT(A2),D4 BEQ.S WAIT_LOOP2 infinne was called from an ISR * TST.B IN_ISR(A2) BEQ.S NOT_ISR BSR CHECK_DSR_CTS BEQ.S XMIT_CHAR modem lines are up, goto transmit MOVE.L #316,S_ERROR(A2) CTS false error RTS ite timeout if value is 0. BTST #TIMER_PRESENT,SYSFLAG2 SEE IF TIMER EXISTS ttt JS 8/3/83 BEQ.S WAIT_TMR IF SO GO USE IT ttt JS 8/3/83 MOVE.L D4,D7 \ LSL.L #1,D7  side effect -- Z:=0 * * Wait (with timeout) for DSR and CTS * NOT_ISR EQU * LEA CHECK_DSR_CTS,A4 \ call WAIT with appropriate BSR WAIT / function parameter BEQ.S  \ initialize counter LSL.L #2,D4 \ (multiply by 54) ADD.L D7,D4 | MOVE.L D4,D7 / LSL.L #3,D4 / ADD.L D7,D4  XMIT_CHAR no errors, goto transmit RTS (Z=0 still) * * Send the character (in d3) * XMIT_CHAR EQU * MOVE.B D3,DATA(A1) do actual transmit CLR.B D7  / WAIT_LOOP EQU * TST.L S_ERROR(A2) check for errors saved during wait BNE.S EXIT_WAIT exit (Z=0) JSR (A4) check the condition BEQ.S EXIT_WAIT       ADDQ #6,SP CLEANUP STACK ttt JS 8/3/83 RTS AND DONE! ttt JS 8/3/83 page ****************************************************************************** * * CHECK_EMPTY * tells if queue is empty. * ON EXIT: Z=empty (IF EMPTY THEN Z:=1 ELSE Z:=0) * USES : D7 *----------------------------------------------------------------------------- QUEUE_EMPTY EQU * MOVE.W Q_OUT(A2),D_DSR_CTS, CHECK_QUEUE * * FUNCTIONs to be used with WAIT, they all return Z=1 when the * condition is met. * * USES: the function is allowed to use only d6 and d7 * *********************************************************************7 CMP.W Q_IN(A2),D7 * RETURN( queue_in = queue_out ) RTS *----------------------------------------------------------------------------- * QUEUE_FULL * tells if queue is full. * ON EXIT: Z=full (IF FU exit if conditon met (Z=1) SUBQ.L #1,D4 counter := counter - 1 BPL.S WAIT_LOOP MOVE.L #TMO_ERR,S_ERROR(A2) save the timeout error (Z:=0) RTS WAIT_LOOP2 EQU * wait loo********* * * condition: queue is empty * CHECK_QUEUE EQU * MOVE.W Q_OUT(A2),D7 (12) CMP.W Q_IN(A2),D7 (12) Z=1 if empty EORI #$04,CCR (20) invert the Z bit (Z=1 if full) p for infinite timeout TST.L S_ERROR(A2) check for errors saved by ISRs BNE.S EXIT_WAIT exit (Z=0) JSR (A4) BNE.S WAIT_LOOP2 EXIT_WAIT EQU * RTS WAIT_TMR EQU * MOVE RTS (----> 44 ) * * condition: DSR=1 and CTS=1 (ok to send with modem handshake) * CHECK_DSR_CTS EQU * MOVE.B MODEM_STAT(A1),D7 (12) OR.B D7,S_MODEM(A2) (16) save modem status for user.B #1,-(SP) SET UP TIMER RECORD ttt JS 8/3/83 MOVE.L D4,-(SP) D4 HAS MS TO WAIT ttt JS 8/3/83 WAIT_TMR1 EQU * ttt JS 8/3/83 TST.L S_ERROR(A2) CHECK F NOT.B D7 ( 4) AND #$30,D7 ( 8) if both DSR and CTS were true, Z=0 NOP ( 4) RTS (----> 44 ) TTL RS232 DRIVERS -OR ERRORS ttt JS 8/3/83 BNE.S WAIT_TEXIT BR IF ERROR ttt JS 8/3/83 JSR (A4) CHECK CONDITION ttt JS 8/3/83 BEQ.S WAIT_TEXIT BR IF CONDITION MET ttt JS 8/3/83 - queue utilities page ***************************************************************************** * * Buffer routines * ***************************************************************************** *--------------------------------------- PEA (SP) POINT TO TIMER REC ttt JS 8/3/83 JSR CHECK_TIMER AND CHECK TIMER ttt JS 8/3/83 BPL WAIT_TMR1 IF NO TIMEOUT BRANCH ttt JS 8/3/83 ADDQ #6,SP ------------------------------------- * INIT_QUEUE * initializes the queue descriptor. *---------------------------------------------------------------------------- INIT_QUEUE EQU * MOVE.W #BUFFER_SIZE,Q_SIZE(A2) * iniTIMEOUT, BUT GET ONE ttt JS 5/3/84 MOVEQ #20,D4 MORE CHANCE WITH ttt JS 5/3/84 BRA WAIT_LOOP SHORT COUNT ttt JS 5/3/84 WAIT_TEXIT EQU * ttt JS 8/3/83tialize queue_size CLR.W Q_IN(A2) * queue_in := 0 CLR.W Q_OUT(A2) * queue_out := 0 RTS *----------------------------------------------------------------------------- * QUEUE      LL THEN Z:=1 ELSE Z:=0) * USES : D7 *----------------------------------------------------------------------------- QUEUE_FULL EQU * MOVE.W Q_IN(A2),D7 * ADDQ.W #1,D7 * CMP.W Q_OUT( d7.W - queue_in *----------------------------------------------------------------------------- OUTQUEUE EQU * MOVE.W Q_OUT(A2),D7 * MOVE.B Q_BUFFER(A2,D7.W),D2 * char := (queue_addr+queue_out)^ ADDQ.WA2),D7 * queue_out = queue_in+1 ? BNE.S CHECK_OR * RTS * ( YES so return with Z=1) CHECK_OR EQU * CMP.W Q_SIZE(A2),D7 * queue_in+1 = queue_size ?  #1,D7 * queue_out := queue_out+1 CMP.W Q_SIZE(A2),D7 ** BGE.S RESET_OUT * IF queue_out >= queue_size MOVE.W D7,Q_OUT(A2) * RTS * RESE BEQ.S CHECK_AND * RTS * ( NO so return with Z=0) CHECK_AND EQU * MOVE.W Q_OUT(A2),D7 * queue_out = 0 ? RTS * ( ANSWER iT_OUT EQU * * CLR.W Q_OUT(A2) * THEN queue_out := 0 RTS ** page *----------------------------------------------------------------------------- * QUEUE_SPACs result of function ) page *----------------------------------------------------------------------------- * INQUEUE * puts a character in the queue * ON ENTRY: d2.B - character to be put in the queue * E * returns amount of space remaining in the queue * ON EXIT: d3.W - contains the space remaining in the queue. *----------------------------------------------------------------------------- QUEUE_SPACE EQU * MOVE.W Q_OUT(Abuffer NOT full !! * USES : a4.L - queue_addr * d7.W - queue_in *----------------------------------------------------------------------------- INQUEUE EQU * MOVE.W Q_IN(A2),D7 * MOVE.B 2),D3 * SUB.W Q_IN(A2),D3 * IF queue_in >= queue_out BGT.S OUT_GREATER * SUBQ.W #1,D3 * THEN queue_space := ADD.W Q_SIZE(A2),D3 * queue_size + que D2,Q_BUFFER(A2,D7.W) * (queue_addr+queue_in)^ := char ADDQ.W #1,D7 * queue_in := queue_in+1 CMP.W Q_SIZE(A2),D7 * BGE.S RESET_IN * IF queue_in >= queue_size MOVE.W D7ue_out-queue_in - 1 RTS OUT_GREATER EQU * SUBQ.W #1,D3 * ELSE queue_space := RTS * queue_out-queue_in - 1 END ,Q_IN(A2) * RTS * RESET_IN EQU * * CLR.W Q_IN(A2) * THEN queue_in := 0 RTS * *---------------------------------------- (* (c) Copyright Hewlett-Packard Company, 1985. All rights are reserved. Copying or other reproduction of this program except for archival purposes is prohibited without the prior written consent of Hewlett-------------------------------------- * OUTQUEUE * take the next character out of the queue * ON ENTRY: buffer NOT full * ON EXIT : d2.B - character from the queue * USES : a4.L - queue_addr * Packard Company. RESTRICTED RIGHTS LEGEND Use, duplication, or disclosure by the Government is subject to restrictions as set forth in paragraph (b) (3) (B) of the Rights in Technical Data and Computer Software clause in DAR 7-104.9(a). HEW      (* *) (* date - 6 August 1982 *) (* update - 5 June 1985 *) (* release - 12 Jul  *) (* *) (************************************************************************) $PAGE$ (*************************************** 1985 *) (* *) (* source - IOLIB:RS_DRV.TEXT *) (* object - IOLIB:RS_DRV.CODE *********************************) (* *) (* *) (* This is the source code for an external procedures library LETT-PACKARD COMPANY Fort Collins, Colorado *) { $SEARCH 'IOLIB:KERNEL.CODE'$ } $COPYRIGHT 'COPYRIGHT (C) 1985 BY HEWLETT-PACKARD COMPANY'$ $MODCAL ON$ $PARTIAL_EVAL ON$ $STACKCHECK ON$ $RANGE OFF$ $DEBUG OFF$ $OVFLCHECK OFF$ $PA *) (* *) (************************************************************************) $PAGE$ (************************************************************************) (* GE$ (************************************************************************) (* *) (* RELEASED VERSION 3.1 *) (*  *) (* *) (* BUG FIX HISTORY *) (*  *) (************************************************************************) (* *) (*  *) (* ------ for 3.0 release *) (* jws J Schmidt io_init_rs Find 98644 cards *) (* 3/5/84 * *) (* IOLIB RS_DRIVERS *) (* *) (* *) (************) (* ------ for 3.1 release *) (* jws2 J Schmidt io_init_rs Add default setups *) (* 6/5/85 using control regs *) (* ************************************************************) (* *) (* *) (* library - IOLIB  21 and 22. *) (* *) (* *) (*  *) (* name - RS_DRIVERS *) (* module(s) - init_rs *) (* - rs *)  *) (* *) (* *) (* *) (* !      *) (* to be used for general purpose interfacing on the HP 9826. *) (* *) (* The library consists of 3 primary sets of modules - *) (* es to point to the correct drivers. *) (* *) (* The rest of the IOLIB modules are high-level modules that are *) (* used by an end user in his/her application *) (* 1. KERNEL modules *) (* 2. driver modules *) (* 3. IOLIB modules  program. *) (* *) (* The KERNEL and some set of driver modules will exist in the *) (* INITLIB file as object code ( not EXPORT text ). The *) (*  *) (* *) (* The KERNEL modules consist of the following modules - *) (* *) (*  export text will reside on the IO file. The rest *) (* of the library will reside on the IO file. *) (* *) (************************************ 1. iodeclarations ( contains static r/w space ) *) (* 2. iocomasm *) (* 3. general_0 ( initialization & low level *) (* rou************************************) $PAGE$ (************************************************************************) (* *) (* tines like ioread/iowrite) *) (* The KERNEL modules also have an executable program segement *) (* that gets executed at the time it is loaded. This program *) (* initializes the static read/write memory. This program also *) ( *) (* REFERENCES : *) (* *) (* *) (* 1. 9826 * allocates the temporary storage for any card that exists - *) (* independent of whether there is or is not a driver for it. *) (* *) (* The driver modules consiI/O Designers Guide ( Loyd Nelson ) *) (* *) (* 2. 68000 Manual ( Motorola ) *) (* st of the actual assembly or PASCAL *) (* routines that deal with a specific interface card. There is *) (* also an executable program segment for each driver module. *) (* This program searches the select code table in the stat *) (* 3. Pascal Language System Users Manual ( 9826-90070 ) *) (* *) (* 4. Pascal Procdure Library Users Manual( 9826-90074 ) *) (* ic r/w *) (* initialized by the KERNEL general_0 module for all select codes *) (* that have the right interface card ( HPIB drivers will search *) (* for the 98624 interface ). This program will then set up the *) (* driver tabl *) (* 5. 9826 card documentation ( Mfg. Specs. ) *) (* *) (* 6. Pascal I/O Library IRS !     temp : ANYPTR ; val : CHAR); PROCEDURE rs_rdw ( temp : ANYPTR ; VAR x : io_word); PROCEDURE rs_wtw ( temp : ANYPTR ; val : io_word); PROCEDURE rs_rds ( temp : ANYPTR ; reg : io_word; VAR x : ioppens if an ISR fires during init } io_lvl:=((ioread_byte(io_isc,3) DIV 16) MOD 4)+3; IF io_tmp_ptr^.myisrib.INTREGADDR <> NIL THEN BEGIN { if isr exists then unlink it } ISRUNLINK(io_l_word); PROCEDURE rs_wtc ( temp : ANYPTR ; reg : io_word; val : io_word ); PROCEDURE rs_tfr ( temp : ANYPTR ; bcb : ANYPTR ); END; { of rs } $PAGE$ MODULE init_rs; { update 3/5/84 jws vl , { level } ADDR(io_tmp_ptr^.myisrib)); { isrib info } END; { of IF } PERMISRLINK(io_drv_ptr^.iod_isr, { isr } ANYPTR(INTEGER ( Tim Mikkelsen ) *) (* *) (* 7. 98626A ERS ( Mfg. Specs. ) *) (*  purpose This module initializes the RS 232 drivers. } IMPORT iodeclarations ; EXPORT VAR rs_drivers : drv_table_type; PROCEDURE io_init_rs; IMPLEMENT IMPORT sysglobals , isr , general_0 ,  *) (* *) (************************************************************************) PROGRAM rs_initialize ( INPUT , OUTPUT ); $PAGE$ (********************************************** rs ; PROCEDURE io_init_rs; TYPE baudarraytype = ARRAY [0..15] of io_word; {jws2 } CONST baudarray = baudarraytype[50,75,110,134,150,200, 300,600,1200,1800,2400,3600, 4800,72**************************) (* *) (* *) (* RS-232 CARD DRIVERS *) (* 00,9600,19200]; {jws2 } VAR io_isc : type_isc; dummyword : io_word; io_lvl : io_byte; io_baudsw : io_word; {jws2} io_linesw : io_word;  *) (* *) (************************************************************************) EXTERNAL MODULE rs; { upda{jws2} BEGIN io_revid := io_revid + ' R3.2'; { set up the driver tables } WITH rs_drivers DO BEGIN rs_drivers := dummy_drivers ; iod_init := rs_init; iod_isr := rs_isr; iod_rdb := rs_rdb; iod_wtb := rs_te 2/14/83 purpose This module is a declaration of the importation text for the external drivers. note The assembly language code that is imported needs to be called 'rs'. The routines need to wtb; iod_rdw := rs_rdw; iod_wtw := rs_wtw; iod_rds := rs_rds; iod_wtc := rs_wtc; iod_tfr := rs_tfr; END; { of WITH } { set up drivers for the interfaces } FOR io_isc:=iominisc TO iomaxisc DO WITHbe called 'rs_@@@@@@' } IMPORT sysglobals, iodeclarations ; EXPORT PROCEDURE rs_init ( temp : ANYPTR ); PROCEDURE rs_isr ( temp : PISRIB ); PROCEDURE rs_rdb ( temp : ANYPTR ; VAR x : CHAR); PROCEDURE rs_wtb (  isc_table[io_isc] DO BEGIN IF (card_id = hp98626) or (card_id=hp98644) { jws 3/5/84 } THEN BEGIN io_drv_ptr:=ADDR(rs_drivers); { if the card exists then link in an ISR for it } { ??? - what ha"     (card_ptr)+3), { card address } 192, { intr. mask } 192, { intr. value } io_lvl, { level  n cRS_DRV n cPRINTER n cF9885 n cAMIGO n cCS80 n aBUB_DVR n cBUBBLES n cEPROMS n a VME.ASM n c VME.PAS n ********************************************************************* * NOW LINKEM TO PRODUCE THE ACTUAL MODULES ************************** } ADDR(io_tmp_ptr^.myisrib)); { isrib info } END; { of IF card_type = hp98626 } END; { of FOR io_isc WITH isc_table[io_isc] BEGIN } { call the actual driver initialization } FOR io_isc:=iominisc  ********************************************************************* loPRINTER. lnPRINTER x Copyright Hewlett-Packard Co.,1982,1991 All rights reserved. iPRINTER alkq loAMIGO. lnAMIGO x Copyright Hewlett-Packard Co.,1982,1991 All rights reserved. iAMIGTO iomaxisc DO WITH isc_table[io_isc] DO IF (card_id = hp98626) OR (card_id = hp98644) { jws 3/5/84 } THEN BEGIN io_baudsw:=0; { jws2 } io_linesw:=0; O alkq loCS80. lnCS80 x Copyright Hewlett-Packard Co.,1982,1991 All rights reserved. iCS80 alkq lh1 oRS232. lnRS232 dx Copyright Hewlett-Packard Co.,1982,1991 All rights reserved. iRS_DRV aiRS alkq lh1 oF9885. lnF9885 x Copyright Hewlett-Packard Co.,198 { jws2 } IF card_id=hp98626 THEN BEGIN { jws2 } io_baudsw:=ioread_byte(io_isc,5) MOD 16; { baud switch - jws2 } io_linesw:=ioread_byte(io_isc,7); { pickup line control- jws2 } 2,1991 All rights reserved. iF9885 aiGPIODVR alkq lh1 oBUBBLE. lnBUBBLE x Copyright Hewlett-Packard Co.,1984,1991 All rights reserved. iBUB_DVR aiBUBBLES alkq lh1 oEPROMS. lnEPROMS x Copyright Hewlett-Packard Co.,1984,1991 All rights reserved. iEPROMS alEND { jws2 } ELSE BEGIN { jws2 } io_baudsw:=10; { defaults for 98644 } { jws2 } io_linesw:=3; kq lo VMELIBRARY. i VME.ASM ai VME.PAS akq *********************************************************************** * DONE BUILDING AND LINKING VARIOUS INITLIB MODULES ******************* ****************************************************************** { jws2 } END; iocontrol(io_isc,21,baudarray[io_baudsw]); { jws2 } iocontrol(io_isc,22,io_linesw); { set defaults } { jws2 } CALL( io_drv_ptr^.iod_init, io_tmp_ptr ); END; { of WITH IF } END; { ***** of io_init_rs } END; { of MODULE init_rs } $PAGE$ IMPORT init_rs , LOADER ; BEGIN io_init_rs; MARKUSER; END. { of rs_initialize }  TTL IOLIB COMDCL - common equates and definitions PAGE ******************************************************************************** * * modified: 02/22/82 JPC added parm to user EOT & ISR proc's * 08/01/83 JS added *********************************************************************** * STREAM FILE TO MAKE VARIOUS INTERFACE DRIVERS *********************** *********************************************************************** aDRVASM n cDISCHPIB n aGPIODVR n aRStimer_present and sysflag2 equ's * 03/25/85 JS added got_68020, cache_ctl equ's * * ******************************************************************************** * * HPL CONVENTIONS * * * Much of this code is taken in"      TEMPLATE * * OFFSET FROM A2 * * HPL DECLARATIONS ( MODIFIED ) * * ******************************************************************************** ISR_ENTRY EQU 0 ..19 PASCAL ISR LINK & UNLINK area USER_ISR EQU 20  05 overlp INTR * 06 overlp DMA * 07 overlp FHS ( BURST ) * 08 overlp FASTEST ( DMA or BURST ) *  user ISR: do NOT change the proc/stat link/parm ordering!!! H_ISR_PR EQU 20 ..23 procedure ptr H_ISR_SL EQU 24 ..27 static link H_ISR_PM EQU 28 ..31 parameter C_ADR EQU 32 ..35 card addre 09 overlp OVERLAP ( DMA or INTR ) T_BW_OFF EQU 10 transfer byte/word indicator * 0 = byte / 1 = word TEND_OFF EQU 11 transfer EOI/END indicator * tact from the 9826 HPL * language system EIO ROM ( extended I/O ROM ). * This was written by Bob Hallissy ( originally John Nairn ). * The Pascal that will be calling this code uses * the stack for parameter passage. The HPss BUFI_OFF EQU 36 ..39 buffer pointer offset BUFO_OFF EQU 40 ..43 buffer pointer offset EIRB_OFF EQU 44 eir byte IO_SC EQU 45 select code ( i.e. 7, 22, etc. ) TIMEOUT EQU 46 ..49 timeoutL code * uses the Ax and Dx registers for all parameters. * The Pascal driver entry points on the previous pages * take care of getting the parameters into the correct * registers. * * * GENERAL HPL ENTRY/EXIT CONDITIO value * =0 : no timeout * #0 : value of timeout MA_W EQU 50 ..51 word access to my address MA EQU 51 byte access to my address AVAIL_OFF EQU 52 .NS: * * A1.L = CARD ADDRESS * A2.L = DRIVER TEMP ADDRESS * UNLESS OTHERWISE INDICATED, THESE REGISTERS ARE UNALTERED. * * * NEW ENTRY/EXIT CONDITIONS FOR PASCAL USE : * * A3.L = BUFFER CONTROL BLOCK ADDRESS * .?? standard space taken from temps * 52 ..83 normal cards ( 32 bytes ) * 52 ..179 98628 card ( 128 bytes ) PAGE ******************************************************************************** * *  In addition to the A1/A2 convention, Pascal will use * A3 for a pointer to the buffer control block. * The HPL system kept much of the transfer * information in the s.c. temps. * * TIMEOUT(A2) = co TRANSFER OFFSETS IN BUFFER CONTROL BLOCK * * OFFSET FROM A3 * * PASCAL DECLARATION * ******************************************************************************** TTMP_OFF EQU 0 ..3 pointer to driver temp offset T_SCntains timeout information * Timeout was a global temp in HPL and a timeout * generated an error. * In PASCAL each card has a timeout value stored in * its temporary area. A timeout error * _OFF EQU 5 transfer select code TACT_OFF EQU 7 actual transfer mode TUSR_OFF EQU 9 transfer mode * 00 - not used * 01  generates an ESCAPE ( which can be trapped ). * * ******************************************************************************** PAGE ******************************************************************************** * * * DRIVER TEMPSserial DMA * 02 serial FHS * 03 serial FASTEST ( DMA or FHS ) * 04 - not used * ---------------- * #      0 = no eoi / 1 = eoi sent or searched for TDIR_OFF EQU 13 transfer direction * 0 = input / 1 = output TCHR_OFF EQU 14 ..15 transfer terminate character * SY EQU 8 sc is currently busy BUF_BUSY EQU 9 the buffer is busy TCNTERR EQU 10 bad count BADTMO EQU 11 bad timeout value NO_DRV EQU 12  -1 = no termination character TCNT_OFF EQU 16 ..19 transfer count TBUF_OFF EQU 20 ..23 transfer buffer pointer TBSZ_OFF EQU 24 ..27 transfer buffer maximum size TEMP_OFF EQU 28 ..31 transfer empty poin no driver NO_DMA EQU 13 no dma installed NO_WORD EQU 14 no word transfers allowed NOT_TALK EQU 15 not addressed as talker NOT_LSTN EQU 16 not addresseter pointer TFIL_OFF EQU 32 ..35 transfer fill pointer T_PR_OFF EQU 36 ..39 transfer pointer to eot procedure * NIL no procedure T_SL_OFF EQU 40 ..43 transfer eot proc static link T_PM_OFF d as listener TMO_ERR EQU 17 timeout NO_SCTL EQU 18 not system controller BAD_RDS EQU 19 bad read status / write control BAD_SCT EQU 20 bad set/clear/test CEQU 44 ..47 transfer eot proc parameter T_DMAPRI EQU 48 dma priority request * * TRANSFER EQUATES * TT_INT EQU 1 interrupt TT_DMA EQU 2 DMA TT_BURST EQU 3 burst TT_FHS RD_DWN EQU 21 interface is dead EOD_SEEN EQU 22 end of data has happened IO_MISC EQU 23 misc. error SPC 3 IOE_ERROR EQU -26 io sub system error escape cod EQU 4 fast handshake TTL IOLIB IOCOMASM - escape support PAGE ******************************************************************************** * * EXTERNAL REFERANCES for escape * ********************************************e SPC 3 IOE_RSLT EQU IODECLARATIONS-66 IOE_SC EQU IODECLARATIONS-70 SPC 3 ESC_CODE EQU SYSGLOBALS-2 RCVR_BLK EQU SYSGLOBALS-10 TIMER_PRESENT EQU 1 JS 8/1/83 SYSFLAG2 BIT -- 0=>TIMER PRESENT GOT_68020 EQU 4 ************************************ REFA iodeclarations reference the io lib var. area REFA sysglobals SPC 2 ******************************************************************************** * * Escape code values * ************** JS 3/25/85 SYSFLAG2 BIT -- 1=>68020 PRESENT SYSFLAG2 EQU $FFFFFEDA JS 8/1/83 CACHE_CTL EQU $5F400E JS 3/25/85 ****************************************************************** NO_CARD EQU 1 no interface NOT_HPIB EQU 2 not an hpib interface NO_ACTL EQU 3 no active controller NO_DVC EQU nosyms mname gp src module gp; src src import src sysglobals, mini; src src export src type src gpiotype = { gpio interface card definition } src packed record case integer of src  4 sc ( not device ) specified NO_SPACE EQU 5 not enough space in the buffer NO_DATA EQU 6 not enough data left in the buffer TFR_ERR EQU 7 tfr error SC_BU 0: {direct byte access} src ( r0,r1,r2,r3,r4,r5,r6,r7: byte ); src 1: {read access} src ( {r0} R0pad:0..127; ready:boolean; src {r1} R1pad:0..7; cardid:0..31; src {r2} #     r3_type; src var dma_channel: dmachanneltype; src buffer: charptr; length: integer); src procedure gpiodmain (var gpio: gpiotype; src command: shorti escape page * * gpiowaitready with 2 second timeout * waitready move.l #206,d0 timeout counter * * Counter changed to be about 1 ms at 16 MHz -- was 206185 * by jws 8/10/83 * waitready_loop btst #3,7(a1) periphent; src enable_byte: gpio_r3_type; src var dma_channel: dmachanneltype; src buffer: charptr; length: integer); src end; {gpio} page * * dmaout/dmain stack ral status? bne ioresc_catchall ioresc(zcatchall) if so btst #0,(a1) ready? bne.s waitready_rts branch if so subq.l #1,d0 decrement the timeout counter bgt waitready_loop R2pad: byte; src {r3} Renab,req:boolean; intlevel:0..3; burst,Rword,Rdmac1,Rdmac0: boolean; src {r4} Rdata: src {r5} shortint; src {r6} R6pad:byte; src {r7} R7frame definitions * olda6 equ +0 (long) old stack frame pointer radd equ +4 (long) return address len equ +8 (long) length of transfer in words buf equ +12 (long) apad:0..15; psts,eir,sti1,sti0:boolean ); src 2: {write access} src ( {r0} setpctl:byte; src {r1} reset:byte; src {r2} W2pad:0..63; rdyen,eiren:boolean; src {r3} Wenab:bddress of buffer chan equ +16 (long) dma channel base address enab equ +20 (byte) gpio dma enable byte stackpad equ +21 (byte) unused - caused by pushing byte on stack cmnd equ +22 oolean; W3pad:0..15; Wword,Wdmac1,Wdmac0: boolean; src {r4} Wdata: src {r5} shortint; src {r6} W6pad:byte; src {r7} W7pad:0..63; ctl1,ctl0:boolean ) src end; { gpio i(word) disc command (read/write/verify) gpio equ +24 (long) gpio card base address * * Def's & Ref's * def gp_gp def gp_gpioclear def gp_gpiowordout def gp_gpiowordin def gp_gpiodmaout def nterface card definition } src src gpio_r3_type = {separate declaration for use with structured constants} src packed record src {r3} Wenab:boolean; W3pad:0..15; Wword,Wdmac1,Wdmac0: boolean; src end; src  gp_gpiodmain refa sysglobals refa mini_ioresc refa check_timer jws 8/10/83 lmode mini_ioresc lmode check_timer jws 8/10/83 timer_present equ 1 jws 8/10/83 sysflag2  src dmachanneltype = packed array[0..7] of byte; src src var src dma_port[5242880]: array[0..1] of dmachanneltype; src src procedure gpioclear (var gpio: gpiotype); src procedure gpiowordout (var gpio: gpio equ $fffffeda jws 8/10/83 * * module initialization routine * gp_gp rts * * ioresult assignments * ztimeout equ 4 zcatchall equ 21 * * error exits * ioresc_catchall moveq #zcatchall,d0 type; datum: shortint); src function gpiowordin (var gpio: gpiotype): shortint; src procedure gpiodmaout (var gpio: gpiotype; src command: shortint; src enable_byte: gpio_ zcatchall ioresult ioresc move d0,-(sp) push the ioresult jsr mini_ioresc set ioresult then escape(-10) bus_error move #-12,sysglobals-2(a5) set the escapecode trap #10 $     loop until timeout count expired * * Low data rate if we get here, so use timer if have it jws 8/10/83 * 8 MHz loop code is duplicated from above jws 8/10/83 * jws 8/10/83 **************************************************************************** gp_gpioclear movea.l (sp)+,a0 pop the return address movea.l (sp)+,a1 pop the gpio card base address move.b d0,1(a1) reset thbtst #timer_present,sysflag2 jws 8/10/83 beq.s waitready_timer use timer jws 8/10/83 move.l #206185,d0 else set 2 sec loop jws 8/10/83 waitready_loop2 btst #3,7(a1) peripheral status? bne iore card move.l #200,d0 prepare to... * * Count changed from 100 to 200 for 16 MHz processors jws 8/10/83 * dbra d0,* wait a while... clr.b 7(a1) clear ctl1 & clt0 bsr waitready esc_catchall ioresc(zcatchall) if so btst #0,(a1) ready? bne.s waitready_rts branch if so subq.l #1,d0 decrement the timeout counter bgt waitready_loop2 loop until timeout count  before testing psts & ready jmp (a0) return ******************************************************************************* * gpiowordout * ********************expired bra.s wait_timeout timeout on 2sec loop jws * waitready_timer equ * jws 8/10/83 move.b #1,-(sp) setup timer record jws 8/10/83 move.l #2000,-(sp) time to wait jws 8/1*********************************************************** gp_gpiowordout movea.l (sp)+,a0 pop the return address movea.l 2(sp),a1 gpio card base address bsr waitready wait until ready move (sp),40/83 waitready_tloop btst #3,7(a1) check psts jws 8/10/83 bne ioresc_catchall if not there,escape jws 8/10/83 btst #0,(a1) check card ready jws 8/10/83 bne.s waitready_texit if so then done jws 8/10/83 (a1) output the datum move.b d0,(a1) set pctl addq.l #6,sp pop off the parameters jmp (a0) return ****************************************************************************** pea (sp) point to timer rec jws 8/10/83 jsr check_timer timed out? jws 8/10/83 bpl waitready_tloop no--try again jws 8/10/83 addq #6,sp yes, clean stack jws 5/2/84 moveq #10,d0 * * gpiowordin * ******************************************************************************* gp_gpiowordin movea.l (sp)+,a0 pop the return address movea.l (sp)+,a1  give one more try jws 5/2/84 bra waitready_loop2 with a short count jws 5/2/84 waitready_texit addq #6,sp cleanup stack jws 8/10/83 waitready_rts rts and continue jws 8/10/83 wait_timeout  gpio card base address bsr waitready wait until ready move 4(a1),(sp) input the datum move.b d0,(a1) set pctl (same manner as 98032 autohandshake) jmp (a0) return moveq #ztimeout,d0 ztimeout ioresult bra ioresc escape ****************************************************************************** * gpioclear * ** page ******************************************************************************* * gpiodmaout * ******************************************************************************* gp_gpio$      branch if not (bus error) bsr waitready wait for the final handshake to complete unlk a6 remove our stack frame movea.l (sp)+,a0 pop the return address adda #20,sp  move d0,4(a2) set the dma count move #$0002,6(a2) arm the dma channel di_reni move (sp)+,sr re-enable interrupts ****************** lea 7(a1),a3 gpio register 7 address m pop off the parameters jmp (a0) return page ******************************************************************************* * gpiodmain * ***********************oveq #3,d0 psts bit (gpio register 7) lea 7(a2),a4 dma status lower byte address moveq #0,d1 armed bit (dma status register) di_loop btst d0,(a3) psts? bne iordmaout link a6,#0 create our own stack frame movea.l gpio(a6),a1 gpio card base address bsr waitready wait for previous handshake to complete trap #11 move into supervisor ******************************************************** gp_gpiodmain link a6,#0 create our own stack frame movea.l gpio(a6),a1 gpio card base address bsr waitready wait for previous handshake to mode (scs) * scs move sr,-(sp) prepare to disable interrupts ori #$2700,sr disable interrupts ******************* move cmnd(a6),4(a1) disc command move.b d0,(a1) set pccomplete trap #11 move into supervisor mode (scs) * scs move sr,-(sp) prepare to disable interrupts ori #$2700,sr disable interrupts ******************* move cmnd(a6),4(atl move.b enab(a6),3(a1) enable the gpio card for dma movea.l chan(a6),a2 dma channel base address move.l buf(a6),(a2) set the dma address move.l len(a6),d0 transfer length subq.l #1,d0 1) disc command move.b d0,(a1) set pctl moveq #0,d0 ready bit (register 0) lea 7(a1),a2 register 7 address moveq #3,d1 psts bit (register 7) d_loop btst length-1 move d0,4(a2) set the dma count move #$0006,6(a2) arm the dma channel move (sp)+,sr re-enable interrupts ****************** lea 7(a1),a3 gpio register 7 address d1,(a2) peripheral status? bne.s d_enab fall out of the critical section if so btst d0,(a1) ready? beq d_loop branch if not clr 4(a1) clear the ou moveq #3,d0 psts bit (gpio register 7) lea 7(a2),a4 dma status lower byte address moveq #0,d1 armed bit (dma status register) do_loop btst d0,(a3) psts? bne tput buffer move.b d0,(a1) set pctl, requesting the first word in d_enab move.b enab(a6),3(a1) enable the gpio card for dma movea.l chan(a6),a2 dma channel base address move.l buf(a6),(a2)  ioresc_catchall ioresc(zcatchall) if so btst d1,(a4) dma channel still armed? bne do_loop keep looping if so cmpi #-1,4(a2) dma transfer complete normally? bne bus_error  set the dma address move #-1,4(a2) set count to -1 for the case of one transfer move.l len(a6),d0 transfer length subq.l #2,d0 length-2 blt.s di_reni branch if one transfer only %     esc_catchall ioresc(zcatchall) if so btst d1,(a4) dma channel still armed? bne di_loop keep looping if so page cmpi #-1,4(a2) dma transfer complete normally? bne bus_error est and toggle - semaphore manipulation function * drvasm_test_and_toggle equ * movea.l (sp)+,a0 pop the return address movea.l (sp)+,a1 pop the var parameter address bchg #0,(a1) test and toggle the semaphore sne d0  branch if not (bus error) bsr waitready wait for last handshake to complete movea.l buf(a6),a0 buffer address move.l len(a6),d0 transfer length in words add.l d0,d0 transf remember the previous state neg.b d0 form a legal PASCAL boolean move.b d0,(sp) set the return variable jmp (a0) return page * * exclusive or - error correction procedure * drvasm_eor moveer length in bytes move 4(a1),-2(a0,d0.l) transfer last word unlk a6 remove our stack frame movea.l (sp)+,a0 pop the return address adda #20,sp pop off the parameters jmp (aa.l (sp)+,a0 pop the return address movea.l (sp)+,a1 pop the bufptr move.b (sp)+,d0 pop the correction character eor.b d0,(a1) do it to it jmp (a0) return * * shift left n places * drvasm_shifted_lef0) return end t equ * movea.l (sp)+,a0 pop the return address move (sp)+,d1 pop the shift count move.l (sp)+,d0 pop the operand asl.l d1,d0 do it to it move.l d0,(sp) set the return value jmp (a0)  nosyms ****************************************************************************** * driver assembly routines * ****************************************************************************** * * Preturn * * shift right n places * drvasm_shifted_right equ * movea.l (sp)+,a0 pop the return address move (sp)+,d1 pop the shift count move.l (sp)+,d0 pop the operand asr.l d1,d0 do it to it move.l d0,(sp) ASCAL interface text * mname drvasm src module drvasm; src src import src sysglobals; src src export src function test_and_toggle(var semaphore: boolean): boolean; src procedure eor(correction_byte: char; bufp set the return value jmp (a0) return * * take a mod power of 2 * drvasm_mod_power_of_2 equ * movea.l (sp)+,a0 pop the return address move (sp)+,d1 pop n moveq #-1,d0 start with all ones asl.l tr: charptr); src function shifted_left(value: integer; n: shortint): integer; src function shifted_right(value: integer; n: shortint): integer; src function mod_power_of_2(value: integer; n: shortint): integer; src src end; {d d1,d0 shift in n zeros not.l d0 invert the sense and.l (sp)+,d0 pop and mask the operand move.l d0,(sp) set the return value jmp (a0) return end rvasm} * * def's * def drvasm_drvasm def drvasm_test_and_toggle def drvasm_eor def drvasm_shifted_left def drvasm_shifted_right def drvasm_mod_power_of_2 * * module intialization routine * drvasm_drvasm rts * * t (* (c) Copyright Hewlett-Packard Company, 1983. All rights are reserved. Copying or other reproduction of this program except for archival purposes is prohibited without the prior written consent of Hewlett-%     : integer; {total transfer byte count } bx_tfr_length : integer; {intermediate tfr byte count } bdx_chain_semaphore : boolean; {data transfer semaphore } bdx_pre_eoi : boolean; {procedure deallocate_bkgnd_info(uep: uep_type); var saved_ioresult: integer; begin {deallocate_bkgnd_info} if bip_valid(bip_type(uep^.dvrtemp)) then with bip_type(uep^.dvrtemp)^ do begin set_in_use := false; uepremature eoi flag } bdx_nb : integer; {data transfer byte count } bdx_proc : io_proc; {data transfer completion proc } buf_info : buf_info_type; {as defined by the io^.dvrtemp := ord(iores); lockdown; if async then {call the eot procedure} begin saved_ioresult := ioresult; ioresult := uep^.dvrtemp; call(feot, fibptr); ioresult := saPackard Company. RESTRICTED RIGHTS LEGEND Use, duplication, or disclosure by the Government is subject to restrictions as set forth in paragraph (b) (3) (B) of the Rights in Technical Data and Computer Software clause in DAR 7-104.9(a). HEWlibrary } end; bip_type = ^bi_type; $page$ procedure initialize_bkgnd; procedure allocate_bkgnd_info (uep: uep_type); procedure deallocate_bkgnd_info(uep: uep_type); procedure abort_bkgnd_process (uep: uep_type); procedure ioresc_LETT-PACKARD COMPANY Fort Collins, Colorado *) $modcal, debug off, range off, ovflcheck off, stackcheck off, iocheck off$ $search 'DRVASM' { , 'IOLIB:KERNEL' } $ program init_bkgnd; module bkgnd; import sysglobals, misc, iodbkgnd (uep: uep_type; ior: iorsltwd); function unit_busy (uep: uep_type): boolean; procedure unit_wait (uep: uep_type); implement {bkgnd} const n = 3; {number of bkgnd info sets} type bia_type = array[0..n-1] of beclarations; export type uep_type = {unit entry pointer} ^unitentry; bi_type = {background info} record iores : iorsltwd; {ioresult } set_in_use : boolean; {alloi_type; var bia_ptr: ^bia_type; index: shortint; procedure initialize_bkgnd; var local_index: shortint; begin {initialize_bkgnd} if bia_ptr=nil then new(bia_ptr); for local_index := 0 to n-1 do bia_ptr^[local_index].set_ication flag } async : boolean; {overlapped transfer flag } feot : eotproc; {end of transfer procedure } fibptr : fibp; {file information block n_use := false; index := 0; end; {initialize_bkgnd} function bip_valid(bip: bip_type): boolean; var local_index: shortint; begin {bip_valid} bip_valid := false; for local_index := 0 to n-1 do if bip=addr(bia_ptr^[local_index])ptr } read_operation : boolean; {transfer direction flag } buffered_transfer : boolean; {amigo driver flag } xfr_chain_semaphore : boolean; {driver semaphore } b then bip_valid := true; end; {bip_valid} $page$ procedure allocate_bkgnd_info(uep: uep_type); var bip: bip_type; begin {allocate_bkgnd_info} lockup; repeat bip := addr(bia_ptr^[index]); index := index+1; if indx_tries : shortint; {number of previous tries } bx_strt_rcrd : integer; {record address } bx_bufptr : charptr; {R/W address pointer } bx_length ex>=n then index := 0; until not bip^.set_in_use; uep^.dvrtemp := integer(bip); with bip^ do begin iores := inoerror; set_in_use := true; async := false; end; {with} end; {allocate_bkgnd_info} p&     ved_ioresult; end; {if} end; {with} end; {deallocate_bkgnd_info} procedure abort_bkgnd_process(uep: uep_type); begin {abort_bkgnd_process} if escapecode<>-10 then {prevent any eot procedure call while deallocating} bip_ {selective device clear} LAG_base = 32; {listen address group base} TAG_base = 64; {talk address group base} SCG_base = 96; {secondary command group base} procedure delay_timer(microsec_value: integer); external; procedtype(uep^.dvrtemp)^.async := false; deallocate_bkgnd_info(uep); if escapecode<>-10 then escape(escapecode); end; {abort_bkgnd_process} procedure ioresc_bkgnd(uep: uep_type; ior: iorsltwd); begin {ioresc_bkgnd} if bip_valid(bip_type(uep^.dure confirm_timeout_and_reset_card(uep: uep_type); begin {confirm_timeout_and_reset_card} if (escapecode<>ioescapecode) or (ioe_isc<>uep^.sc) then escape(escapecode); if ioe_result<>ioe_timeout then ioresc_bkgnd(uep, znodevice); with isc_tablvrtemp)) then bip_type(uep^.dvrtemp)^.iores := ior; escape(-10); end; {ioresc_bkgnd} $page$ function unit_busy(uep: uep_type): boolean; begin {unit_busy} if bip_valid(bip_type(uep^.dvrtemp)) then unit_busy := true else bee[uep^.sc] do call(io_drv_ptr^.iod_init, io_tmp_ptr); ioresc_bkgnd(uep, ztimeout); end; {confirm_timeout_and_reset_card} $page$ function Simon_no_DMA(uep: uep_type): boolean; begin {Simon_no_DMA} with isc_table[uep^.sc] do Simon_ngin unit_busy := false; ioresult := uep^.dvrtemp; end; {else} end; {unit_busy} procedure unit_wait(uep: uep_type); begin {unit_wait} while unit_busy(uep) do {nothing}; end; {unit_wait} end; {bkgnd} $page$ $copyright 'COPo_DMA := (card_id=hp98625) and not dma_here; end; {Simon_no_DMA} function Simon_DMA(uep: uep_type): boolean; begin {Simon_DMA} with isc_table[uep^.sc] do Simon_DMA := (card_id=hp98625) and dma_here; end; {Simon_DMA} procedure HPIBcheck_YRIGHT (C) 1983 BY HEWLETT-PACKARD COMPANY'$ module discHPIB; import sysglobals, iodeclarations, drvasm, bkgnd; export function Simon_no_DMA (uep: uep_type): boolean; function Simon_DMA (uep: uep_type): boolean; procedure HPIBcsc(uep: uep_type); begin {HPIBcheck_sc} with isc_table[uep^.sc] do begin if card_type<>hpib_card then ioresc_bkgnd(uep, znodevice); with io_tmp_ptr^ do while (in_bufptr<>nil) or (out_bufptr<>nil) do {nothing}heck_sc (uep: uep_type); procedure HPIBwait_for_ppol (uep: uep_type); procedure HPIBshort_msge_out (uep: uep_type; sec: byte; bp: charptr; nb: shortint); procedure HPIBamigo_clear (uep: uep_type); procedure HPIBshort_msge_in (uep: uep_ty; end; {with} end; {HPIBcheck_sc} procedure HPIBwait_for_ppol(uep: uep_type); var pprb: packed array[0..7] of boolean; {parallel poll response byte} begin {HPIBwait_for_ppol} try with isc_table[uep^.sc], io_drv_ptr^ do pe; sec: byte; bp: charptr; nb: shortint); function HPIBamigo_identify (uep: uep_type): shortint; procedure HPIBget_amigo_ident(uep: uep_type; var ident: shortint); procedure HPIBupon_ppol_resp (uep: uep_type; proc: io_proc); procedure HPIBupon_dx repeat call(iod_ppoll, io_tmp_ptr, charptr(addr(pprb))^); until pprb[uep^.ba]; recover confirm_timeout_and_reset_card(uep); end; {HPIBwait_for_ppol} $page$ procedure address_for_msge_out(var isc_te: isc_table_type; ba, fr_comp (uep: uep_type; sec: byte; bp: charptr; nb: integer; proc: io_proc); implement {discHPIB} const standard_tc = 5000; {standard byte timeout value milliseconds} short_tc = 25; {short byte timeout value milliseconds} SDC = 4; sec: byte; tc: integer); var dummy_char: char; begin {address_for_msge_out} with isc_te, io_drv_ptr^ do begin call(iod_send, io_tmp_ptr, '?'); io_tmp_ptr^.timeout := tc; call(iod_send, io_tmp_ptr, chr(TAG_base+io_t&     chr(SDC)); call(iod_send, io_tmp_ptr, '?'); end; {with} recover confirm_timeout_and_reset_card(uep); end; {HPIBamigo_clear} $page$ procedure address_for_msge_in(var isc_te: isc_table_type; ba, sec: byte; tc: integer); var p_type): shortint; var isc_te_ptr: ^isc_table_type; ident: {the two identify bytes} record case integer of 0: (word: shortint); 1: (upper_char, lower_char: char); end; eoi_set: boolean; begin {HPIBamigo_identify} dummy_char: char; begin {address_for_msge_in} with isc_te, io_drv_ptr^ do begin call(iod_send, io_tmp_ptr, '?'); io_tmp_ptr^.timeout := tc; call(iod_send, io_tmp_ptr, chr(LAG_base+io_tmp_ptr^.addressed)); call try isc_te_ptr := addr(isc_table[uep^.sc]); address_for_msge_in(isc_te_ptr^, {"ba"} 31, {"sec"} uep^.ba, short_tc); with isc_te_ptr^, io_drv_ptr^ do begin call(iod_rdb, io_tmp_ptr, ident.upper_char); callmp_ptr^.addressed)); call(iod_send, io_tmp_ptr, chr(LAG_base+ba)); if card_id<>hp98625 then {delay to avoid Chinook bug} delay_timer(85 {microseconds}); call(iod_send, io_tmp_ptr, chr(SCG_base+sec)); call(iod_ppol(iod_send, io_tmp_ptr, chr(TAG_base+ba)); if card_id<>hp98625 then {delay to avoid Chinook bug} delay_timer(85 {microseconds}); call(iod_send, io_tmp_ptr, chr(SCG_base+sec)); call(iod_ppoll, io_tmp_ptr, dummy_char); {enfl, io_tmp_ptr, dummy_char); {enforce timeout} end; {with} end; {address_for_msge_out} procedure HPIBshort_msge_out(uep: uep_type; sec: byte; bp: charptr; nb: shortint); var isc_te_ptr: ^isc_table_type; begin {HPIBshort_msge_out} try orce timeout} if card_id<>hp98625 then {delay to avoid Chinook bug} delay_timer(85 {microseconds}); end; {with} end; {address_for_msge_in} procedure premature_eoi(uep: uep_type); begin {premature_eoi} with isc_table[uep^. isc_te_ptr := addr(isc_table[uep^.sc]); address_for_msge_out(isc_te_ptr^, uep^.ba, sec, standard_tc); with isc_te_ptr^, io_drv_ptr^ do begin while nb>1 do begin call(iod_wtb, io_tmp_ptr, bp^); sc] do call(io_drv_ptr^.iod_send, io_tmp_ptr, '_'); ioresc_bkgnd(uep, zbadhardware); {all "expected" premature eoi's have to be trapped} end; {premature_eoi} procedure HPIBshort_msge_in(uep: uep_type; sec: byte; bp: charptr; nb: shortint);  bp := addr(bp^, 1); nb := nb-1; end; {while} call(iod_set, io_tmp_ptr, ord(eoi_line)); call(iod_wtb, io_tmp_ptr, bp^); call(iod_send, io_tmp_ptr, '?'); end; {with} recover  var isc_te_ptr: ^isc_table_type; eoi_set: boolean; begin {HPIBshort_msge_in} try isc_te_ptr := addr(isc_table[uep^.sc]); address_for_msge_in(isc_te_ptr^, uep^.ba, sec, standard_tc); with isc_te_ptr^, io_drv_ptr^ do  confirm_timeout_and_reset_card(uep); end; {HPIBshort_msge_out} procedure HPIBamigo_clear(uep: uep_type); var isc_te_ptr: ^isc_table_type; begin {HPIBamigo_clear} try isc_te_ptr := addr(isc_table[uep^.sc]); address_for_msge_obegin while nb>1 do begin call(iod_rdb, io_tmp_ptr, bp^); call(iod_end, io_tmp_ptr, eoi_set); if eoi_set then premature_eoi(uep); bp := addr(bp^, 1); nb := nb-1; ut(isc_te_ptr^, uep^.ba, 16, standard_tc); with isc_te_ptr^, io_drv_ptr^ do begin call(iod_set, io_tmp_ptr, ord(eoi_line)); call(iod_wtb, io_tmp_ptr, chr(0)); {disable parity check} call(iod_send, io_tmp_ptr,  end; {while} call(iod_rdb, io_tmp_ptr, bp^); call(iod_send, io_tmp_ptr, '_'); end; {with} recover confirm_timeout_and_reset_card(uep); end; {HPIBshort_msge_in} $page$ function HPIBamigo_identify(uep: ue'     (iod_end, io_tmp_ptr, eoi_set); if eoi_set then premature_eoi(uep); call(iod_rdb, io_tmp_ptr, ident.lower_char); call(iod_send, io_tmp_ptr, chr(TAG_base+io_tmp_ptr^.addressed)); end; {with} recover confirm_ with isc_te_ptr^, buf_info do begin drv_tmp_ptr := io_tmp_ptr; active_isc := no_isc; { act_tfr is set by the driver } if dma_here then usr_tfr timeout_and_reset_card(uep); HPIBamigo_identify := ident.word; end; {HPIBamigo_identify} procedure HPIBget_amigo_ident(uep: uep_type; var ident: shortint); begin {HPIBget_amigo_ident} ident := HPIBamigo_identify(uep); end; {HPIBget_amigo_id := overlap_FASTEST {DMA, or BURST FHS if both channels are busy} else usr_tfr := serial_FHS; {unlike BURST FHS, won't lock out interrupts} b_w_mode := false; { end_mode is setup in inient} procedure HPIBupon_ppol_resp(uep: uep_type; proc: io_proc); { NOTE: when SIMON drivers become available, this routine needs to be modified to utilize the "interrupt on parallel poll response" capability of SIMON. However, until then, tiate_transfer } direction := t_dir; term_char := -1; { term_count is setup in initiate_transfer } buf_ptr := anyptr(bp); buf_size := nbthis will have to do. } var pprb: packed array[0..7] of boolean; {parallel poll response byte} begin {HPIBupon_ppol_resp} try with isc_table[uep^.sc], io_drv_ptr^ do repeat call(iod_ppoll, io_tmp_ptr, charptr(ad; buf_empty := anyptr(bp); buf_fill := anyptr(bp); eot_proc.real_proc := upon_transfer_complete; eot_parm := uep; dma_priority := card_id=hp9dr(pprb))^); until pprb[uep^.ba]; recover confirm_timeout_and_reset_card(uep); call(proc, uep); end; {HPIBupon_ppol_resp} $page$ procedure enter_bdx_chain(uep: uep_type); forward; procedure initiate_transfer(uep: uep_type); forwa8625; end; {with} bdx_chain_semaphore := false; enter_bdx_chain(uep); end; {with} recover confirm_timeout_and_reset_card(uep); end; {HPIBupon_dxfr_comp} $page$ procedure enter_bdx_chain(uep: uep_type);rd; procedure upon_transfer_complete(uep: anyptr); forward; procedure HPIBupon_dxfr_comp(uep: uep_type; sec: byte; bp: charptr; nb: integer; proc: io_proc); var isc_te_ptr: ^isc_table_type; t_dir: dir_of_tfr; begin {HPIBupon_dxfr_comp} try begin {enter_bdx_chain} with bip_type(uep^.dvrtemp)^ do if not test_and_toggle(bdx_chain_semaphore) then repeat initiate_transfer(uep); until test_and_toggle(bdx_chain_semaphore); end; {enter_bdx_chain} procedure i isc_te_ptr := addr(isc_table[uep^.sc]); with bip_type(uep^.dvrtemp)^ do begin if read_operation then begin address_for_msge_in (isc_te_ptr^, uep^.ba, sec, standard_tc); t_dir := to_memnitiate_transfer(uep: uep_type); var maximum_term_count: integer; begin {initiate_transfer} with bip_type(uep^.dvrtemp)^, isc_table[uep^.sc], buf_info do begin if (usr_tfr=serial_FHS) or (card_id=hp98625) then maximum_teory; end {then} else begin address_for_msge_out(isc_te_ptr^, uep^.ba, sec, standard_tc); t_dir := from_memory; end; {else} bdx_nb := nb; bdx_proc := proc; rm_count := maxint {"no" limitation} else maximum_term_count := 65536; {DMA hardware/9914 driver limitation} if bdx_nb<=maximum_term_count then term_count := bdx_nb else term_count := maximum_term_count; bdx_'      This floppy contains the source for various Pascal Workstation drivers (PRINTER, AMIGO, CS80, RS232, BUBBLE, EPROMS, VMELIBRARY). The modcal version of the PaWS Pascal compiler is required to build the various drivers. A copy of this compiler can be founGCONVERT_TEXT_ANY_TO_UCSDCONVERT_TEXT_CONVERT_TEXT FS_FANONFILE FS_FBLOCKIO FS_FCLOSEITFS_FEOF FS_FHPOPEN FS_FHPRESET FS_FINITB FS_FIXNAME FS_FMAKETYPEFS_FPAGEFS_FREAD FS_FREADBYTES FS_FREADCHAR FS_FREADLN FS_FREADSTRFS_d on the SCSI: source floppy disk. A stream file (MAKE_ALL.TEXT) which shows how to build and link the drivers is also included. FSFS_FSEEK FS_FWRITECHAR FS_FWRITEINT FS_FWRITELN FS_FWRITEPAOC FS_FWRITESTRFS_FWRITESTRCHARFS_FWRITESTRINTFS_FWRITESTRWORD FS_FWRITEWORD FS_SCANTITLE FS_SUFFIXLDR_LDR LOADER_LOADERMFS_FWRITEREAL MISC_MISCSYSDEVSSYSnb := bdx_nb-term_count; end_mode := (direction=to_memory) or (bdx_nb=0); call(io_drv_ptr^.iod_tfr, io_tmp_ptr, addr(buf_info)); end; {with} end; {initiate_transfer} procedure upon_transfer_complete(uep: anyptr); var unaddresCOMP3:M:DEVGLOBALS#sglobals; export const crevid = daterec[year:91,day:28,month:10]; crevnmY MAINBODY.TEXTT= 'Pascal'; {title} copyright1 = 'Copyright Hewlett-Packard Company, 198sing_char: char; begin {upon_transfer_complete} with bip_type(uep_type(uep)^.dvrtemp)^, isc_table[uep_type(uep)^.sc], io_drv_ptr^, buf_info do try if direction=to_memory then {check for premature transfer termination} if bdx_2, 1991.'; copyr;INIT:CONVERT.CODE FULLDUMP = false; (* conditional compilation for tree dump *) allowmodcal = TRUE;  conditional comLIBS:SYSLIB2.CODEAL$ *) MC68020 = TRUE; (* conditional compnb=0 then bdx_pre_eoi := term_count<>0 else call(iod_end, io_tmp_ptr, bdx_pre_eoi) else bdx_pre_eoi := false; if (bdx_nb>0) and not bdx_pre_eoi then {re-initiate the transfer} enter_bdx_chain(uep)ʷ L-COPYRIGHT HEWLETT-PACKARD COMPANY, 1982, 1990*0LSF0F0LY~PGLOBALSRN\YSP ALIAS ALLOW_PACKED ANSI CALLABS IF  else {unaddress the bus and call the specified end-of-transfer procedure} begin if direction=to_memory then unaddressing_char := '_' {untalk} else unaddressing_char := '?'; {unlisten}  END CODE COPYRIGHT DEBUG DEF FLOAT_HDW HEAP_DISPOSE INCLUDE IOCHECK LINES LIST LINENUM MODCAL OVERLAY OVERLAY_SIZE OVFLCHECK PAGE PAGEWIDTH P call(iod_send, io_tmp_ptr, unaddressing_char); call(bdx_proc, uep); end; {else} recover confirm_timeout_and_reset_card(uep); end; {upon_transfer_complete} end; {discHPIB} $page$ import loader, bkgnd; begin +>A ASM_ARCTANASM_ASM ASM_ASSIGN ASM_BCD_REAL ASM_BINARYASM_CLOSEFILESASM_COSASM_DIFFERENCEASM_DIVASM_EQASM_EXP ASM_FLOATASM_GEASM_GTASM_HEX ASM_INTERSECTASM_LEASM_LNASM_LT ASM_MEMAVAILASM_MOD ASM_MOVEL ASM_MOVELEF{init_bkgnd} initialize_bkgnd; {allocate temp space} markuser; {make temp space and modules permanent} end. {init_bkgnd} TASM_MPYASM_NE ASM_NEQUAL ASM_NEWBYTES ASM_NEWWORDS ASM_OCTALASM_RADDASM_RDIVASM_RMULASM_RSUB ASM_SAPPENDASM_SCAN ASM_SCOPYASM_SINASM_SQRTASM_SSUBTOPSUB ASM_UNIONASM_XADELEMENTASM_XINCICI_CI CI_STREAMIN(     DEVS_SYSDATESYSDEVS_SYSDEVSSYSDEVS_SYSTIME SYSGLOBALSSYSGLOBALS_SYSGLOBALSʷ L-COPYRIGHT HEWLETT-PACKARD COMPANY, 1982, 1990*0LSF0F0LY~PUNUMEGLOBALSRN\Y RP/-NpE.Wre.Wgb-mx nx0.H!@!mpcnf0-"S@H ` nx0-H m0-C$nxA|Sbp./HzNJg ;|NJ`R/-/Hz ?<&?=continue, <>=terminate, E=edit Error in interface text: =continueNA nCSb/-N ALIAS ALLOW_PACKED ANSI CALLABS IF END CODE COPYRIGHT DEBUG DEF FLOAT_HDW HEAP_DISPOSE INCLUDE IOCHECK LINES LIST LINENUM MOD/-Hn? NA;m0-?HnHnNH +n, .Dg?<2NB `-n N^.NuPNA n Bp$mg?<N`jJ-g n  n m`L-m np.h l?<NB`( n"n  HhN .A?0?<N .RhJ g8Hm./Hz?< ?>>>>> Error at NA n C "n Hi0( H/NN3lN^ _ NNAm B- N3lpmfBmACSb`"p mfBmACSbJmg4Bn0-H/HzNJf?<NHzN8z`d=|B.p%n^.Ag>A0.CCpR@ fS@A-HU nHh?-<N6Jf ;|NJ n+hHm-_"n#m U+@+h;h ;h;h`NT;mN^Nu0NAR -^ WgJmo Hm.NRmHm./Hzz?<?RmA$m2-HCSb` ?<NۈpmWrmWg N3l`(p4mf |1`?<NLHz2N8zJ.1g4`J-&f!m1mHm-_ n(rf+|!m`BBJm ^-&rmWgNPRmNRmBBmNp`F?<aNU m0-Hp?-<NJf;|NJ`Hm _!nN^.NuNAJ-!g ?<]NF|!-m,ml| ?<XN&Y/N*-_J] ^g?<N`Jmf ;n` ?<NJmgHm0-H/N`RU/NJ_`Bpmf+mNS`&Y/N-_pPo;|P,?<Nn`& o;|,?<NP`;n,`U/N_`J-lHzRHnHnNH nl+n, .Tg?<N` .<@@ N^.NuPNAJ-&f ?<XNp"mf@Y/.N n nJ] n ^g?<N~ n `<Hn/.Np.Ar:0g>ACESbN8z` Hz :N8z| `0.mΰ|$n@2;N;| Hmpz/NBmB.1p$mfb<xHn/NZ`BmAtCSb`~Bm?<NHz?< ??<??<?-n n0@2;N &.`*Hm.Hh ?>>>>/(0.T@?NM:` n/(0.T@?NM:`N^ _\ON..realcharset file max=scalararray recordintegerbooleanpointerelsize= (OFLO) align= signedNIL type bitsize=elbitsize=prok parmlnn=@ n-P0.R@h0.H/ nHhNJgHm.<1?J(8gHm.Hz?<?-HN n"m"Q"Q"QJgg NIFN^ _ NNAB.JVJ Vg n "n0)$h$g` np h$gf n "n ) gR n h phf(U n/( n /( /N`Jf`` nph$V.g` nphf0U n h&/( n h&/(B'.N,Jf`\J. U/NJg`( n-h` n-h`Sm` nBN^.NuNA?<eA"n$i$RGESb<HPHz>-HN n"m"Q"Q"QU n/(N_ nphV n(8Ag& n P"n "QpR@ f S@f``0 n-h n -h ` . W@ON^ _ NNA . f |`$J WJWg |` n"n 0)hf n 0(@2;N|Rf^RZ . DW". HW .DW$.HWg0-&ABA-H n0(S@@2;N.U/(Hn"n/NJg/N|`,U n/(Hn"n/N(Jg/N| n-PJgfY/.Hn"n/NYZ-_JfD?<eA"n"QECSb<HPHz>-HN nHPN|U nB`8B.`0 . `W".`WA`U n /( n/(N_` . XW".XWA`U n /( n/(N_`B.` n "n()f B.`^ n "n(")"g |`@U/. NNU/.NDg U n /(/(N.n N^.Nu already definedNAB. Jg8 nphf* nJ(g n-h .PW@ N^.NuNAB. U/.NJg nh" N^.NuNAB. JgJ nJhf> nphW".TVAn -.g ?<^N. n/(Nt_`B.`,B.`$U n /( n/(B'B'N_``V n phfU n /(/.N_`. nphfU/. n/(N_`B.N^ _PONNA-n nphf"n ""n"` .Hf n n `z .DN^.NuNAHn/<&N-n nB(B(0.H 1|Hh HmN n1|!mP|1| B("Hh/<N n-h"nB)"3|Hi HmN n1|!mD!|0.H!@-n N^ _TONNA o?<N.-|Y?. W nJhVg"n ""n"`H n B .Pf n `( nJg n h"n"` nBN^ _ NNA n CSb/./<,N n-P nHPHnNd n!md B1|HhHmN n!m6 1|0.H!@1|$N^ _N n Hn <"< RlR/N-n n0"n Jg1| "n i `J n h"n3h p=i nn(=@ n h0."n2.  0.R@h n0( R@H-nn=@ n0. 0.HRh n0( HV-g ?<^N. n NNu      "8 #(1n -n nB!nN^ _ NNAB. JgD-n nphf0pW-g (DW"(HWA N^.NuNAJ WJWg |`RU/. N~U/.Ntg2 n"n ) n "n ")W@`B.N^ _PONNA| NAJmf-|` -|N^NuNA-n YN AA-H0.@2;N,> n0n`` n01n`N n0!n`<  _ \g n01n` n0!nN^ _\ONNAYN A+     /(&<PHn/N0-HЭT-@Hn/.?<N n/(?<N`H-p爁- nJ(g"-p- (&Ш//N`-p- nJ($g (&Ш/?<N` n-h&/(&<PHn/N20-HЭT-@ n ( \"( _-0(-`6-p㈁-p*n WrTAm?퉃m/.N` nph fL-p㈁-m?p툁m-p爁- n-0(-B?<N`H-p㈁-m?p툁m-p爁- n-0(-B?<NN`\p2n WrAg.Hn/.?<N n (/?<N `$Hn/.?<N n/(?<N`8-p爁--p- n/($?( N` n-h$-p爁-0-HЭT-@"nJ)g. (Щ -@ .-@ \ _-@g-p--㉃-m?p툁m/.N`$-p㈁-m?p툁m/.N`-?p툁-p=n D@-ԁ-/.N`-p㈁-m?p툁m n ($l^-爁- n ($-Ձ-`~-p㈁-m?p툁m-p爁- n-A-H-n nBh0=|Rn=|Rn n0.HЀ2.4BJAHЂ$0$pJgJnWrAn=AJ.g4"n0.2AI@tD<Fűtv᫇`2 npn2AI@tD<FŰtv᫇ nmD nm0N^ _\ONNA/.?<N*` nJh(W-g0-p-Hzb/.?<N/.?<N` n ( \"( _g>-p-"n/)/.?<N n (/?<N`,-p-Hz/.?<N/.?<NV` nJh(W-g8-p-n npPfD"n  p2( H-An$-@ n ."n ".  .Rh` ;|NJN^ _NNA n-hYN AA-H np]r^ph"WJ$Vg"n3|$n*p* ^ ]g:4-"n/)/.?<N n/(?<N`-p- n ( \"( _g2"n/)/.?<N n (/?<N`( n/(/.?<N n/(?<N~`Hn/<N n"h$$n%i"h$#n-p爁--p*p鈁*%hJ(g ` n`( n0(p鈁("n1i`< n0"nJm i` n <Ш"n@ n"nJ)g>(0)㈁(piW爁((0)鈁(`( n(p㈁(-0-HЭT"n"/(?<N`jHn/<N n"h$$n%i"h$#n-p爁--p-0-HЭT"n"/(?<N`N^.NuNA0.HЀAh-00鈁-0.H/HzN_0.|<@2;N0(p鈁(N^ _PONNA-n n0("@2;NP, XtXP";|NJ`.-p爁- n-0(-` -p爁- n-0(-`-p爁- n-0(-`-p爁--p-`-p爁- n-j-p㈁-m?p툁m-p爁--p-`<-p㈁-m?p툁m-p爁--p-`?-NjN^ _TON $@NABm0. HЀAX-00鈁-0. H/HzN_0. Q@@2;N0(-`=m n-0(-J(g-p爁-/(/N"` nJWJ$Wg-p爁-`^Bn n ^ ]g-p爁-/(/N` -p爁- n/(?<Nh nJ$gP0.HЭT2.HЁ-@ ($fZZZZZ"ZZZZZZZZZZ&&Z^ZZZZZZZZ""Z8Z````````````````ZZZZZ"ZZZZZZZZZZZZZZZZ0. Q@-ԁ--n nJh f*Jl <Ш@` nh`| nHz/.?<N` n/($/.BgN`b-p爁--p- nJ($g (&Ш/?<N`N n-h&/(&<PHn/Nx0-HЭT-@Hn/.BgN n/(?<N`-p爁--p- nJ($g (&Ш/?<NF`P n-h&/(?<N,`:pn f-p㈁-`HpTn f-p㈁-`,p8n f-p㈁-`-p㈁- nm?0( 툁m/.N`-p㈁-p$n fm?p툁m`6pQn fm?p툁m` nph S@m?툁m-p爁- n,     0(-`>-p㈁-m?p툁m-p- n/(?<N`?-Njpmf?-Nj`8pmf/-N` pmf?-Nj/-NN^ _\ON $@NA n-h"nm?0) 툁mpi"g<0-Xm?툁m$h pif "nh? )툁h` n"nh?0)툁h n"n(0)(/.N` N nph f-p㈁-`-p㈁-m?p툁mYN` AA-H n0"npi"f ` n n"n)0(-0*㈁-/(N`" n-0(㈁-"n/) NN^.NuNA nJhf=|=|=|=|P`=|N=|O=|P=| n-h "npi"Wr$\p$_J$Vg0J$o 1n` n ($D!@$"n3n`P n"hJi"f 1n鈁))p㈁)|/. N` n-0(㈁-pnf4 nph fm?p툁m`m?p툁m`p7nWr"nW nph Wg-p鈁--p㈁-YNH AA-H n0"n(0)鈁(`6 nph"W"n$irj"Vg 3n` /.N~N^.NuNABmBmB. n ph"Wr6nV nph"Vg n"n 3h `L n p h"W nrh W0.H/Hz-AN".g| n 1| "0.HЀA.-00鈁-0.H/HzrN(p㈁(p7nfm?p툁m|`$m?p툁m n(@`m?p툁m/. N`B-p㈁-YN AA-H n0"n(0)鈁((p㈁(m?p툁mm/. N `_0.@2;N(&(00P(fZ00 L& ( /N^Jng`` -n n-n n-0(㈁-Jh"f&ph WrAVAm?퉃m` nm?0( 툁m/. N`X-n n -0(--p爁- nph m?툁m-0(㈁-` nph"f6-n nph"f"p$_r$\g =|6` nph-0(㈁-ph WrAVAm?퉃m/. N` pnf-p㈁-`Hp!nf-p㈁-`,pnf-p㈁-`-p㈁- nm?0( 툁m n p h"W nrh Wg n 1| "/. N8/.N0` n ($- V nJh VtBrA-銅-/. N-=@-=@/.N-m?H@m----0.爁--0.-p4nf-p-`-p鈁- nph WrTAm?퉃m nph"f6-㈁-pPnWrA nh m?퉃m/.N` /Nv` xpnWr.nWԃ-pn]-爁--n n-0(--?0( 툁--n nph"f ($-㈁-`0 n-0(㈁--X-爁-p㈁-/. n ph"WN/. N`2-p㈁-/. nph"WN/.N`\ n-0(㈁--n nJ$m h'` n <Ш$@`/NpMng``-p㈁-m?p툁mYN* AA-H n` n ph"f n -0(㈁-`&-p㈁- n /($?<N0.|@2;N,>-?p툁-`4-?p툁-`"-?p툁-`-?p툁-/.N`` p%nf-p㈁-`-p㈁-m?p툁mYN 0(p("n pi"f(p눁("n )$(("n )$(@("n )$( ("n )$(("n )$(("n )$(("n )$(("n )$((/.N8` n(p눁("n)AA-H n0"n(0)鈁("n pif "n h? )툁h` n"n h?0)툁h n"n (0)(/. Nz` -p㈁-m?p툁mYNJ AA-H n0"n (0)鈁("n$(("n)$(@("n)$( ("n)$(("n)$(("n)$(("n)$(("n)$((/. Nj`YNV AA-H n0-p㈁-m?p툁m0.HЀC,     file, ioresult(NAJfJ-fbHm?<HmHzNHmHzNHmYHmr/-/<0.R@H/<Npg+|;|NJ0. _ NNA m>-HBP1|Bh"m"Qpd "m"Q m PC$nASb0*S@5@0-/<B<Npg+|;|NJN^.NuNAJnW-JWgL/N>HmHzNJg ;|NJ-m n| CR@hjp2-SA=AnnD=@0.HATXCASbYHn/.N =@0.R@hN^.NuNA -Fмlмr 2-PHҀ;AR+|J0-RmHr +@+mP n h-hJg n( nr(ҭJXt+AJp nr(=AnESb`8/-N/-/HzT?<?ZZZZZZZZZZZZZZZL nBh ` n1| ` n1| ` n1|"N^ _ NNA nJho>phl?(N؂ nT` n=hSbHnN|J-9gZ;|| m0+ht+m6?<THmpNyBBn-|?<HnNy-|?<RHnNyN^.NuNAL n1m4(-n n1| "1| BHh$/< N n-h$"n J)g""n $n%i "n |*B*`J n J(,g n|"n p.?N nR nBhBhN^.NuNA n/(N?. N׮ n hRN^ _\ONNA n/(Nd?. N n hTN^ _\ONNA n/(N6/. N n hXN^ _PONNA nJhf./(N nph l"h)g Bg/N< nphnh爁. l `p.?NRF l?.NRF`,-nBnRn0.r6?N| nmVFpnf2 .D-@=|Rn0.r6?NB nmXF.rf*0.H/HzHNJfR?.N|TF0.H/Hz$!i. `& n ()@ n (+AgdAHnT"n 0)6H/-HPN< nPCTESb"n "Q<HPHQ-HLN nLCASb` n PCASb n J g` nHhC$n $j GESb<HQHz`-IN"n0-<A-H n0 .Tlмr 2-HҀ1A"mpd "m mC$nASb -JSR5@5m5|;j0-ZZZZZZZZZZZZZZZL nBh ` n1| `.      n0(h "h3@p il6/ N n h(g Bg/.N nBh"h3h np h obJ l  nph oD-|p2( H-An-@ .Ѯ .Rh/. /.N-_ -n n hphH-@Jl/.N n(g Bg/N P")Wg n-P`Y/. n PHhNb-_N^ _PONNABn|0.n].g*Rn n 0."n2.10W@`nN^ _NNA-n nJfY/. /.N-_` n P=h n0( nlY/. /.N-_`j n0( n(J.g?./ND` ;|NJ` nphf2/.N n(g Bg/N nXBN:` nphfH/.NR n(g Bg/N nL H/./N/./N`PJgH-n n0S@m,|n$@2;N Jgv-h"nJW"n"Q2QWU?.Hh "n"QHi /-AN".g n-P`Y/. n PHhNB-_N^ _PONNA n0m|n@2;N:$PY/.Hm>N-_ `pY/.Hm:N-_ `ZY/.HmBN -_ `D nphfY/.Hm.N-_ `Y/..     `=n nmJnm=n?.Nآ``Jnm=n?.Nآ``:pnf0=|Rn0.6AJpf`b nm?<AC|ESbHn/-D-HN< n nJ\ _g"n3| B)` n1| | n0. h oB"nJ].Ag0. R@1@ |` n1n n` n0. h f(@.g0( R@1@ |`^.@ n(g."nJl0( R@1@ Z1N^ _TONExpression too complex in line NA-nU?. N n1_pn f 1|"` nBh" n1| B(N^ _\ONNA0-jH =@=|=|Jn^Jn\gZ0.6AZA-H nJhf00(H =@Jnm0.nl=n|` nB(` nJ(f0( R@1@ |N^ _PONNAACSb|Jot/./< N =@/./< N-_p0n@ACESbJg" n/(N/.N8 n-h`-mBJg: n/(Nˠ nL H/.N/.N n-h`-m.Jg2 n/(NZ n?( NĀ n?(Nt n-hBBgHnN$?<1HnHnNBpnn6=np=nnn =@?<1HnHnNB0.R@h=n 0.6AZA-H nBh1n 0!|N^.NuNA0.6AZA-H nJPf*phf"hL H3h4( n1|N^ _TONNA=|`-m2Jg2 n/(N n/( Nn n/(Nb n-h`/N.N^NuNA=|Rn=|RnJnW2.H/Hm(-@N .fb0.2.6ҀAZA-H nBPBphW.Ag"hL H3h4( n1| nmn nmZRn?.N nmN^NuNA n-h nph"WJWJh WJ$W(@@ N^.NuNA-n n-h"n=i -Q$n$j&hLH7j(( n1n N^ _PONNA n phf n -h . TV". PV nAN^ _;|b+|dBmh;m@j;|,+|.Bm2;|4;|N^ _TONNA . .-1gS. -.2l+m.2-n n1|"pm@f1|!m$` n1|B$ n!m.B(B(Bh N^ _PONNA0. 2.6ҀAZA-HJn W nrhVgPONNA-n n-h"n0)"H/HzNN n(g4hB(=h Bh /.<Nx nn1n N^.NunNA-n nph"f?<?(N&`l nph"f?<?(N`N n0("H/Hm"NJg2 nph"f Bg?(N nJ(gJo S` ;|NJ nJWrhWpPVgBPN^.NuNApnf4=|Rn0.6A Jpf`n nm` Jnf=|=|=|=|Rn0.6AZA-H nJPfD0(@2;N.``( n0(nl=n=h?<?(NN^.NuNA . l -n `-nN^ _PONNA/. /.N . //.N-_N^ _PONNA-n n-hC-I"np_r\g$nBj |` nJ\ _g"nBi B)`p n \ _g/     CSbAC SbBmh;|N;|R;|;|xB-~BBm;|;|;|;|B-BBm;|;|:;| BB-&B<;|d;|J;|;|t;|BN^Nu.CODENuNA/.NU n-h nJ(g /.Np nph f/.B'NN `B. n/(?<N`JnW.AgTJ.g0| n/(?<N n/(/(?<N`B. n/(/(?<N`,| n/(?<N n/(/(?<N^p!ng0 n"h"ipi"V@J.g /(N}J.gJ.f$?. nx` /.N nJ(g /.NrVN^.NuNA/. NU-n n-h"nJ)g /. N\ nph"f/. ?.<Nr n0( ngv0.h oJ(f?<HnN4?<6HmHnNB/. N n=h ?<0"n/)HnNB n/(N| n1|"h/)"h/)NB`Z n"h"ipi"V"hri W"hpi W"h"i)Bg?<T"h/)Ny`J.f$?. n"h/)"h/)NB`Z n"h"ipi"V"hri W"hpi W"h"i)Bg?<T"h/)Ny n"h"1n|J-g=n?<THnNy`h/. N} nJh WrnWg?<$"n/)Ny`0 n0( nl 0( R@1@ ?<)"n/)Ny``b nph"f/. N}` /. N nph f R`(pnf nT`Jnf nV n1n/)N| n"h/)N| n  nN^ _ NNAJm fNaBm=|Rn=|Rn0.2.6ҀAZppfTRm0.HЀ2.4BJAHЂA tD<FŰtv㫇;n;n`@0.HЀ2.4BJAHЂA tD N^ _\ONNA n -h n0( ng6ph"W"n"iri"Wg /.N}/. ?.NN^ _ NNA n h1| pm4fL/. B'Nx n hBh"?< n/( n /(NBBg n h?(N`?<! n /( n/(NB n/(N|N^ _<FŰtv㫇 nm@ nm,Jmgp0-H/HmN@;|pmf4;mJmf Bm`;|?<0HmHmNB`;|?<5HmHmNBN^NuNAJmo:;|pml?<5HmHmNB`?<0HmHmNBJm fNbN^Nu NNA/.N/. N nJPgp n JPgT n h1| /. N}?< n/( n /(NB n/(N| n /(N|`/./. /N`/. /./NN^ _ NNA-n n"h"ipif/(/(/N. n B`LB. n"h$h0Qo/(NA/.Nu/. NuN^ _ NNA-n n-hJ. g"n3|"` n"h//(N@/.NuN^ _ NNA-n n0( m԰| n@2;N:::^/.B'/Nb n/(/(/N,`/.</N> n/(/(/N`l/.N n/(N` n/(N n/(N n/(Nk n/(Nk n"h-i"n=i"=i i"h-i"n=i"=i ipnf|=|!/(?..Nr n"h-i"n=i ipnfNJ$Wr nVg |`0 np</N n/(/(/N`H/.</N n/(?<N n/(N| n/(Nu` ;|NJNN n0( @2;NP^zzzzlBB4&HzN`VHzN`HHzVN`:HzvN`,HzDN`Hz@N`HzN`N$_r$\g"n/)N}=|`pnfB.=|! n/(?..Nr n"h-i"n=i ipnfNJ$Wr nVg |`0 np$_r$\g"n/)N}=|`=|0.nW..Wg n`pnfN^.NuASM_XIN ASM_UNION ASM_EQUAL ASM_NEQUAL ASM_INTERSECT ASM_INCLUSIONASM_DIFFERENCENAJ-8g ?<SNxN^NuNA/.NUBmx-n n-h (hf("nX?<0/(HmlNB nY`,=| n"h0)$H-@?<0HnHmlNB/.N&|png n/(?<N`pnf*|png n/(/(?<N`\pnW.JnWg| n/(?<N`*pnW.JnWg | n/(/(?<NT`JnW.AgPJ.g0| n/(?<N> n/(/(?<uN^.NuNA-nU n"h/)Nb~Jg n/(NB`L=| n"h"i/)HnHnNj;|x?<0HnHmlNB n/(Nu n/(?<N n/(N| nJg/(?<Nr n/(N|N^.NuNA n"n 0) h g B.` n 0( m/     HmlNB n"P-i?<0HnHmlNB`@=|=|U?<ND=_ n"hpf"n$i *X-@` n"h )T-@?<0HnHnNB=|?<)HnNy?<0HnHmlNB n"hpf Y`U=|?<0HnHnNB=|?<)HnNy/(HnNBBg?.N=|B.BJ.g NN?<+HnNyJ.g NT` B'NNN^ _ NNAJf =| `L n Sm:n02;N$Bn `=| `=| `=| N^.NuNA-nJLf nHh/<*N`?<0HnHmlNB n"P-i=|?<0HnHnNB=|?<)HnNy?<0HnHmlNB?<?.NHnN|`=| n"hpif -h `& nJ(g0( H-@` n-h n/(HnHnNj?<4HnHmlNB-n?<4HnHmlNB-n n!mL"mL+QL n"h$mP""mP"-hU/(N8 n1_ B(Bh B(BBhB(B$BhC-I"nB3|N^.NuNA-nB n"hpi f$/(Hn/.B'.. /.N`P n"hpi ft/(Hn/.B'.. /.NJ.f&Hn/<|*n@2;NVVVVVVVVVVVVVVVVVVVV HzU n /( n/(NXU n /( n/(NB@`4U n /( n/(N_` n"n )W@`U n /( n/(NU n /(?<4HnHmlNBN^ _ NNAJ g-n nph$W-:g"n/)/( <Nm nph$f"n/)Nu` nph$Wrh$Wg"n/)Nu` nph$f"n/)N` np h$f "n /) "n"i/)/N`-n-n  n/(N@` n"n )WU n /( n/(-@N .@`~ n"n )W n"n ")WA`L n J(g4 nJ(g n"n )W@`B.`B.`B.N^ _PONNAB n p&h f/<HnXN nphf -h ` n-h& n/(N n 2;N8^^`t n"h"iJi g /(BgN`R n"h"ipi g/(?<N`, n"h"ipi g/(?<Nr`` n0(H/HzNJg n-h"nJQg/(N|@HnR/<NHnN/<&N-nRJ nJCX!I"mh$nNL?H?5i$$ nN  nJ!nN1|$ B/.R/. N./.R/.N``HU/. /.NBJf4-n J/. NBnUBgND=_?<, nJ/(HnNB nJ/(N|=|=|zU?<ND=_`Bnd?<`n;|x n"hpil"h0)H/HmlN`?<HmlNyU n/(?<NJf?<; n/(Ny`&J-:f n/(Nk n/(N| np h$g "n-Q n-h `lN^ _PON NA nJf/. Nu`/. nHhNyN^ _PO0HnHnXNBB.WJ-:g n (hfH/.NU-nF nF-hB"nBX?</(HnXNB nBY|W`\ nJp*h VU/(-@FNb~ .Fg6=|Bn n h0($H-@?<!HnHnXNB|WJ.Wg2-|Bn?< HnNy-|?<RHnNNNA n -hJg n hL?H?=h(`;|$LH=m@ n/(NU nJf/(/N\` n"P-i/.NU n-h nph"fl"n$i$jpj f0/)/N nJ$gBg"n/)HnNB`$ n"h"i$n *$ѩ/(yBnUBgND=_/.N?<, n/(HnNB n/(N|=|Bn?<0HnXHnNB?<0HnHnNB=|-|?<PHnHnXNB-|?< HnNyBg?.N?<?.`NBg?.NN^ _PONNA n hphf n/( n /(/./N`/.N} n"h"ipi W"h"i)gB/(/N/.?<NBg n/(HnNB?< n?(N` nJh f/.?<N nph W(Ag/.?<Nx n"h"i|"n$h$j5i$h$j5i $h$jBj/(/NN-n n h S2;N$Bmx`;|x` ;|x` nphf(=|U"n "i"i0)H/Nt=_B.B n-h"h$n$j fpmxf"n$i *X-@` n"h )T-@?<0HnHmlNBpmxf Y`U?<0HnN^ _PONNA-n /. n/N n/(NUJ.g n"h"iBi n/(Nh n-h"n-i$nX5| ?<T/)Ny -T-@BBn?<HnNy;|x?<0 n/(HmlNB nY .S/ -蚐?N n/(N|BgHnN4?<1 n0     N n"n!Q n n/.HnN:?<HnNy`J. fvJ.g n/(/.<NZ`P n/(HnB'NZ-nJg. nJg n-h` n"n!Q n `P n/(/.N{;| J.f&Hn/<N n"n!Q n NN^ _ N ASM_SAPPENDNA n p&h f./. n /(/.N/. n /(/.N`/.B'Nx n h0(6A`rpfZ nC-I"nBi"3| UBgND n1_?<1"n/)"nHiNB n"n"i3h n h0(6AZA-H n/.HnN:0- | m| n@2;NvR.@d?<HnNy`?<HnNy`?<HnNy`?< HnNy`v?<HnNy`d?< HnNy`R?<HnNy`@?< HnNy`.?<HnNy`?< HnNy nBh!|Bh/. /.NN^ _ NNA/. n/(/N/. n/(/N n h0(6AZA-H n1|0BN^ _PONNAB. n (@ n (,Ag n J gB.=|0.m_.Ag: n h "m0.H` ;|NJ/.N8 n"hpi f&/(/./.... /.N6`Z n"hpi fv/(/./.... /.NJ.f&Hn/<N n"n!Q n n/.HnN:?<HnNy`J. g\ n/(/.N{;| J.f8J.fCpR@ fS@f|`Rn`J.gpA"n "i ECSb<HPHzT-HN n"n "Q<HPHQ-HN nCASbHn/<N-n n1|* BBB(Hh/< N n-h"n2p.3@ /<Hi /<<Hn/<&Hn/<N n"n!Q n n/.HnN:0- | m| n@2;NvR.@d?<HnNy`?<HnNy`?<HnNy`?< HnNy`v?<HnNy`d?< HnNy`R?<HnNy`@?< HnNy0) H/N/.NU/.NuHn/<=N n "nHPHQ/<=N nC!I pnf nC ` nC /.HnNx?<+HnNy|N^ _\ON_NA-n n-h"npiVriWg<$hpjn($h//(N@?<; n/(`.?<HnNy`?< HnNy` ;|NJ`rJ.g n/(/.<NZ`P n/(HnB'NZ-nJg. nJg n-h` n"n!Q n NN^ _NNA-nB n"hpi ff/(/.HnB'B'. /.NHn/<NNy`\ n"h-Q.gR=|-n;|?<PHnHmNB n"h3|"/(/(Nپ nphf"h&/)"n/)<N` n/("n/)N nphl;|x0(H/HmlNNpNU n/(BgNJf" n/(HnNx?<+Hn n"n!Q n n/B'HnN:?<HnNy` n"hpi f"/(/.HnB'B'. /.NP`J. g n/(/.N{;| `(;| n/(N} n"h/)N|Hn/<N n"n!Q n n/B'HnN:?- HnNy/.NNyNޞ` n0(| mְ|Hn@2;N<<<8  \6666660(H/Hz>NJg, n"h//(N@?<; n/(N8 n"hpi fj/(/./.... /.NHHn/<N n"n!Q n n/B'HnN:?<HnNy` n"hpi f&/(/./.... /.N`J. g n/(/.N{;| `(;| n/(N} n"h/)N|.y`\ n"h-Q.gR=|-n;|?<PHnHmNB n"h3|"/(/(Nپ n0(H/HzNJg n"h/)Nu` n/("n/)N~NےN np(hWr)hWp"hWr#hWg:CE4GSb$P<HQHR-I@. AgFHn/<N n"n!Q n n/B'HnN:?- HnNyNN^ _NNA n p&h f./. n /(/.N/. n /(/.N``/. N /.NU/.NU n /(Nb~Jg/. Nu` ;|NJNJNHzNN"nHQN` npQhWrJhWgHzN` n0(|E@2;N.jjjjj...jjjjjj Hz6N`>ACESb"n$Q n0( H/HzNJg n/(N}` n/(NU n0( |@2;N  J6Nڦ n-PJf n"h3|""h3| ` n-h"n3| 3|"3|#||B)#m6$` n"h3|""hB)/. BN|`p n"h/)?<Nώ n"h/)N| n"h!Q-h"n-i$Q-j$Q$R-j/.Nu/.BgN:/.N| "hpifdJm f/. Nb`J=|-|?<HnHmNB/. n/(Nj n"h"i$n5i `l n"h"iJ)f/("h"i0) R@?NNJ?<8 n"h/)Ny/. n/(Nj n"h"i$n5i ` n"hpQf /(N/.?<N$/.N|N"NHz2NN| n-h"n3|"|3| ` n-h"n3| |3|"=|-|;|?<PHnHmNB n-h"n/)Nu n-P n/(Nu n-P n/(?<NR n/(N| n-P n/(?<k/. n/(Nj?<Hm n/(NB;| `j n"hpifJm f/. Nb` n/(N|;|$?<THmNy-|Bn?<HnNy-|?<HnHmNB/. n/(Nj n"h"i$n5i ` n"h"iJ)g~"h-i/(N, n/(N|=| np/hf-|`BBmx?<0HnHmlNBNNHzHNNF`pm f6Bn=| BB.B.Hn/< N-n n0p-1@ p=h nn(=@0. n2.C 0.R@h?<THnNyBHnB'HnN}| nph g"n/)0( R@?NB.-|Bn?<HnNy?<8 n"h/)NyJ.gN/. n/(Nj n"h"i$n5i ` n/(Nk/. n/(Nj n"h"i$n5i `/. n/(Nj nBh B(`/. n/(N:?<HnNy;| /. /.N n -h/. N^8 n !nBHnB'HnN:?<HnNyHnN8Bm /. /.N(/. N|HnN8;| N`Jm f/. Nb` n-h"n3| 3|"|$h/*N|NNN n0(|?Nj nBh Bh XB(`~ n"h"ipi"g*J-:g/(/-P<Nm n/(BgN/. n/(Nj nB(`"/. n/(Nj nB(=|-|?<Hn"n/)NB` n"hpifJm f/. Nb`t n/(N|;|x+|@2;N D6(RHzN`DHzN`6Hz*N`(HzN`HzN` HzNN@` n"h/)NuNԸN n0(| @2;N"HzN`HzN` HzNN n-h"n3|"|3| ` ;|NJN^ _?<0HmHmlNB?<0HmHmlNBBNNHz|NNh n1|"1| |`: n"h"iJ)g /(ND n"hp*i f/(?<<Nr`6 n"h-i"npi W)Ag/(?<N\ n"h"ipi fT/(N}?<7 n"h1     N|N0N n0( @2;N DR(6HzdN`DHz^N`6HzXN`(HzRN`HzLN` HzFNN& n1|"N^ _PONASM_EQASM_NEASM_GTASM_GEASM_LTASM_LENA n h hphf/. /.N`/. HnHnN"h"iri W"h"ipi W"h"i)Bg"h-i"npi g>pi"f3| |` n/(/(?<N n/(N| n"h-i"npi g,pi"f3| |` n/(?<N\ n/(N|NVNHzlNN° n-hì?< n /(N4 n hBh J.gX n 0( @2;N (D?<D n /(Ny;| `?<C n /(Ny;| `J.g?<J n /(Ny;| `?<B n /(Ny;| `J.g?<L n /(Ny;| `?<@ n /(Ny;| `~J."n3|"3| |` n/(?<N n/(/(?<N n"h"ipi"fH?<7"h/)"h/)NB n/( "n/)Nj n"h/)N|`V n/(N}?<7 n"h/)"h/)NB n/( "n/)Nj n"h/)N| n"h3| g?<K n /(Ny;| `?<? n /(Ny;| `>J.g?<I n /(Ny;| `?<A n /(Ny;| `T n 0( @2;N (D?<D n /(Ny;| `?<C n /(Ny;| `J.g?<K n /(Ny;| `?<? n  n!mD`H n/(N n"hp*i f"h/)Hn"n/)NH`Bn nph WJnVg"hS/(N} n/(NU n/("h"i?) <Nr n/("h"i?) Nv?< n"h/)"h/)NB n/( "n/)Nj n"h"i$h5i/(Ny;| `J.g?<I n /(Ny;| `?<A n /(Ny;| `~J.g?<J n /(Ny;| `?<B n /(Ny;| `>J.g?<L n /(Ny;| `?<@ n /(Ny;| N^ _PONNA?<HnN4Hn/<N n "hR`F n"h-i"npi"f/(?<<Nr`, nph W(Ag"n/)?<N nph f`> n"hp+i W"h"irW"hpQWg/(?<Nv n/(N} n/(N n"h-i"npi"f/(?<<NB/. HnB'N~H-|?<6HnHnNB-|Bn?<HnNy/.N8=|?<HnNy n -h n1|"1nN^ _PONNA n BPBnRn0.HA".f n 0 nmN^ _ NM7"Q":NApm f@Bn=| Br`, nph W(Ag"n/)?<N nph W"n$i$jrj Wg/)?<N n/(N} n/(?<N nph W-:"hr*i Vg4/(N}=|-|?<Hn n"h/)NB nph fT?<""h/)"h/)NB nB.B.Hn/< N-n n0p-1@ p=h nn(=@0. n2.C 0.R@h?<THnNyBHnB'HnN:?<HnNy;| /.NB n"h -i/( N^8 n"h #nBHnB'HnN:?<HnNyHnN8Bm n/(/( "n/)Nj n-h"n3| |N0`U?<ND;_?<# n"h/)"h/)NB n/( "n/)Nj n-h?<"n?)N n1m1| | n"hp*i W"hJ]"hp*i Vg`?<T/(Ny -T-@BBn?<Hn Nb n/( N|HnN8;| N`Jm f n/( Nb` n-h "n-i/)N| n/(N|NN n0( | @2;N$2HzRN`(HzNN`HzJN` HzFNN n1|"1| |N^.NuASM_RADDASMNyBg n"h/)/(NB .S/ -蚐?N n"h/)N| n!mD` n"h-i"npi"f3| |`2 nph"W"n$i$jrj"Wg /)N} n/(N} n/(?<N` n/(?<NP nph W-:"hr*i Vg_RSUBASM_RMULASM_RDIVNA n-h "npi f/)N| n"h-i"npi"f/(?<<Nr`, nph W(Ag"n/)?<N nph f"n/)N| n/(N n"h"ipi"f/(?<<Nr n"h"ipi W4/(N}=|-|?<Hn n"h/)NB n"h"i3| ?<""h/)"h/)NB n/( "n/)Nj n-h"n3| |ph f?<Q/(Ny n"hp*i W"hJ]"hp*i Vg`?<T/(Ny -T-@BBn?<HnN1     1| ` n1| np h fLU"h/)/NJJg6 n"h-i"n )$D#@$1| -h!h!nN^ _PONNA-n n-h (Lf /NJ` n0( H/HzNJg /N\` nph f /N`z n0( H/HzxNJg /NNB n"h/)N|ND np h f?<8/(NyN$` n/(N}/. n/(Nj n0( HЀCd?1"h/)"h/)NB n"h/)N|N` np h fTpnf /(N}Jng?<8 n"h/)Ny` n;h $?<8HmN`T n"h$h0Qo/(N n/(N` n/(N n/(Nt n"h-i"n=i"=i i"h-i"n=i"=i ipnfppnW.ApnWg/(?<<Nr` n/(?<<Nr n"h-i"n=i iyNX nph f/. /(Nj`/. n/(Nj` nph f "n3| N^ _PON0NA-n nY/(/<-HN@ n Ѩ (!@pWrhWg RB nJWrhW0(l^@@H WgB(N^ _ yBg n"h/)/(NB .S/ -蚐?N`N$ n!mH"h/)N|N^.NuASM_MPYNA n-h "n$iJoB./)N. n"h"ipi g@"hpn/(?<Nr` n/("h"i0) R@?NR`| n/(N} n"h?)`zpnfppnW.ApnWg n/(?<<Nr` n/(?<<Nr n"h-i"n=i ipnWrnWpnW.BpnW.Ag> n/(?<Nf n/(/(?<N2 n1| "n#mD`: n/(?<"h"i?)?<"h"i?) NJ.gN0` n/(N} n"h"iJ)g -T-@BBn?<HnNy-|p n"h")DH-Aưn=@ .-@0.HRhS=|BgHn n"h/)NB .S/ -蚐?N n"h-i"hN* n/(/(?<N n1| "n#mH nph g /. /NrU n"h/)/NX=_U n"h/)/N@=_0. 2.HЁ2;N( )D?"n?)?<?) N`2 n"h-i"h )D?"n?)?</?) N n/( "n/)Nj n"h"i$h5i "hpi f !mD` n!mHN^.NuNAJ-;gBB n"h -i"n3|"U?<ND n1_Bh n"h pi f(/( n/(N}/. n/(Nj n0( HЀC?1"h/)"h/)NB n"h/)N|N`pnf n/(N} np h f0/. /(NjBg n"h/)"h/)NB` np h fJ"n;i $/. /(Nj?<M n HnHn<B'<"h /)N^`( n/( HnHn<B'<"h /)Nn/.N8/.N8N`B n-h "n-i$i&i0+ j m/)N$ n/(N` n/(N n/(N n"h"ipi"fd"h"iBi "n/) /(Nj n0( HЀ"h/)HmNB n"h/)N|`< nph f./. /(Nj?<7 n"h/)"h/)NBN`/. n/(NjJng4 n0( HЀC@?1"h/)"h/)NB` nph f@/(N}/. n/(Nj?<7 n"h/)"h/)NB`C?1"h/)"h/)NB n"h/)N|`r n/(N} n"h"iBi "n/) /(Nj n0( HЀC\?1"h/)"h/)NB n"h/)N|N^.NuNA-n n0("S@@2;N0&&&&&:Bn`~=|`t=|6 n;h $"n0) HЀE?2$i/*HmNB n"h/)N|N` nph f/. /(Nj`/. n/(Nj` np h fp/. /(NjJnf( n;h $Bg"n$i/*HmNB`Bg n"h/)"h/)NB n"h/)N|``j nJ$f =|`P np$_r$\g =|`, np$_r$\g =|`=|`N^ _PONNA-n nph"Wr$_p$\@N^ _PONNA-n U n"h/)/NJg< n"h-i"n )$D#@$p h f  np h fR/(N}/. n/(Nj?<M n"h/)"h/)NB n"h/)N|`R n/(N}/. n/(Nj?<7 n"h/)"h/)NB n"h/)N|N` n/(N}/. n/(Nj n0( HЀC?1"h/)"h/)2     NNA-n n-h-n /.NU nJV(g"n"ipi f/.B'Nx/./.Nj n/(/(Nپ n"n )ѨJ)g<|$i 1j$i j 0) HѨ$n/*&i //.N`&/./.Nj n/( "n/)NپN^ _NL?H?3n( n"h"i"" n"h"ipi"g /(N} n"h -i"n$i$j&n7j7||BkN^.NuNA/.Hn n/(N=|=n n =PJngv n pPf=|?<)HnNypnfBgHnHnNB`?.?.?<?<NNA n-h "hpi f"n/)B'Nx n/( "n/)Nj n/(/(Nپ n/(NV n/(Nk n"h"iJi f/(?<N n"h"ipi W"h"i)Ag/(?<Nb n/(N}=|PU n"h"i"Q0)H/Nt n pPf NL` n 0`pg=|-npnW ^g=|?<)HnNy n 0pnf ?<7HnHnNB n 0`?<7HnHnNBNN^ _NNA-n n-h/(NU n"h-i"h-i"npif /N=_6 n"h"i"Q-i2B.-nJ nJJf /.N nJ-hF0( m|,n@2;NZZZZZZZZZZZZZZZZZZZZ^l~"h"i=ipnf/.N`@pnf/./N`( nJph m/./N` /./J/)Nh nJ!_"nF#h$JPg /./NV` nJ/(N nJ"h"iJ)f/("h"i0) R@?N nJ/(N}=|-| nJph f?<Hn"h/)NB`?<PHn nJ"h/)NBNJ-:g nJ/("h/)B'Nm/. nJ/(Nj n nHh/Np`8 nJhg,0(HЀC01H/?(Hh/N> nBh nJ(g=| n=h n=h=| n=h=h"n0)hl =|?<)HnNy n1| n"n0)hl =|?<)HnNy n1|BgHnHnNB?< n?(Nt`/./N` nJ-hB"nB0)U@m|n@2;N F pi$o`0)$@2;N"$nF5| "` nF1| "` nF1|" nFB$"nB$nJ&jL&H$` nB"nF#h3|"U0(H/Nt nF1_"nBpi$WgBpi$Wg6 nBpN n/./.-HN n -n"n$i V)g6pf Bh `$pf n1| ` n1| N^ _PONNA-n n-h"h/HnN@?<;HnNy nBP/. Nu n-hNj-n n (fJ-:gNHn/<&Nh$Wg& nBph$f&"h pif`` nF1| `( nBp h$f"h pin "nF3| nB"nF#h $ nJ/(/(Nپ` nJJPf(/(/(Nx nF"h$J)fBh(`P nF1|"U"nB0)R@H/Nt nF1_"nB!i8B$$nJ&jpkn1|-n n1|"n$i!j$i!j n/(/.B'Nm n/(?<N n/(N|N n"h oHzZN` Hz"n>pQg.$nF5| "Y/(Nh nB!_"nF#h$` nF1| ""nB!i$Bh(`\/./N`N/<HnN@HnR/<NHnN/<&NHC 1S-@`f n0( @2;N&JJ(g-|` -|`. nJ(g-|` -|` -| n"h"iJ)g B` -| n"h .ư]"h".ʲ^g@B"n/)N} n/(?<NF n/(N} n/(-nRB nBC!I"mh$nNL?H?5i$$ nN  nB!nN/.R/.N/./.RNj`-nB nB/(N/. nB/(Nj nB/(Nz nBJg /(Nf`|/./N `n/. nJ/(/(/N<`T nJ-hB"nBJgb=|x-iZB.dpm@f =|?<N(?< n"h/)"h/)NBHn/<N nB nB/.B'HnN:?<HnNy n"h .ʰlt=|"h-i?<!Hn"n$i/*NBHn/<N n!n nB-n/.B'HnN:?<HnNy` n"h .ưlh=|^`=|^Bz?<HnN4?<0HnVHnNB nB"h"i3nU nB/(NJgL nB"h"i0)6CZC-I>"n>2R/./($nJ/*/Nf` nB"h"iL?H?=i(pnf nB/(B'Nx/. nB/("nJ/)/NU nB/(N"h-i?<!Hn"n$i/*NBHn/<N nB nB/.B'HnN:?<HnNy=| n"h-i?<!Hn"n$i/*NBHn/<N n!n nB-n/.B'HnN:?<HnNyJg /.N8-|?<RHnNy/.JgX nB"h"i0)6CZC-I>"n>3|2#|$h#jL?H? 3n4`=|-|;|?<PHnHmNB nJ/(NuNNHzNN nF1|"/.B'Nx nJ/(/(Nپ`F nJ/(N nJ"h-iB"nBpi 3     J"h"i$nF5i ` ;|NJN^.Nu FS_FBUFFERREFNuNA-n nB0( mN|,nF@2;NZZZZZZZZZZZZZZZZZZZZrrrrrrrrrrrrrrrr:Z::/(Nt n/(Nh` n/(NX` n/(NH n/(N<`"h/)N|=|U?<ND=_ nph f?<b"h/)HnNB`?<Y n"h/)HnNB n1|"1n1| |`D n/(Nt?<c n"h/)"h/)NB/. n/(Nj` n/(N4/. n/(Nj` n"h$h0* i m~ n/(N, n/(N n/(N`v n/(N`f n-hJg n/(N n-P``: n-hJg$ n/(N n/(N n-P``N^.NuNA|/.N޺B- n-h nJh Wrh W(@g/.0( R@?N.N^./(N n"hpi fT"h/)N n/(N n/("h/)Nj n"h"i"i$h$j5i ` n/(N0`~ n"hpi fT"h/)N n/(N n/("h/)Nj n"h"i"i$h$j5i ` n/(N n/(N np hNuNA/.N n hph"gU?<ND=_=|=|-n n-h"nJi Wri W)@g/.0) R@?N. n/(N|?<W n/(HnNB n"h3| "h3|""h3nN^.NuNA/.N;|x?<W n/(HmlNB n/( f ?<d"h/)"h/)NB` ?<a n"h/)"h/)NB n"h/)N|/. n/(Nj`` n"h$h0* i m"hpi fT"h/)N n/(N n/("h/)Nj n"h"i"i$h$j5i ` n/(N n"hpi fTN| n h1|"N^.NuNA/.N/<HnN@=|?<W n/(HnNB?<;HnNy n/(N|N^.NuNA/. N$?<W n /(/.NB n /(N|N^ _PONNA;|Bm\=|Rn0.6ArpfpPW"hr|?@2;N *fH?<["n$i/*HnNB`?<Z n"h/)HnNB`|?<X n"h/)HnNB`^?<^ n"h/)HnNB`@?<] n"h/)HnNB`" n/(NJHn/< N-n nBPLH =| Y/.Nh-_-ni"Vg&Bn=|-|?<Hn/(NBN^.NuNAB. n ph\". DV np*h Vgn/.NU n-h n-h/. HmTHmXNj-n nJ(gNphW(Ag-|`( np(2(@HC 1S-@`f n0( =|B?<`Hn n"h/)NB-|?<fHnNy=|-|=|?<dHn n"h/)NB?<e n"h/)"h/)NB-|Bn?<HnNy?<\ n"h/)"h/)NB n"h"i=i n1|"1n1| |` n/(N n@2;N&JJ(g-|` -|`. nJ(g-|` -|` -| nJ(g .DS-@`B nph W nrh W n ( W.g B.`" .T]".X^g|N^ _ NNAU/./. .NBJg/-3     =| n hphf-|`$ n h0(HA 0S-@?<HnHnNB n/(N| n1| |`=|U?<ND=_=| nJ(g?<%"n/)HnNB`v?<& n/(HnNB=|=| n hphf-|`$ nLWgR"n3| ?<0/(/.NB nX?<0 n/(/.NB nY n1| `?<0 n/(/.NB n/(N|N^ _PONNA/.N޺-n n-h"npi"f/.N`` nph"g"n$ipfR;|xX=|Rn n0. h0(HA 0S-@?<HnHnNB n/(N|?< n?(N n1| | nJ(g1|"1nBh B(BB(N^.NuNA/.NU-n n-h"nJ)gY/)/<-IN@"n ѩpigp=|-|=| nH們/.N?<0 n/(HmlNB nm`V n"hJgH"n;i xpi"WJ$Wg?<HmlNy`?<0 n/(HmlNB n/(N| n1|"N^.NuNA/.N޺-n n-h"hpif/.N``` nph"gR"n/)N|?</Hz(+O/.N/.N} X^ T]g ;|NJ-n n-h=|=|"npi f ;|NJ nJh f/.?<N. n"h=iJTf$=|-mX?<HnHnNB`^=| BHn/< N-n n0!mT !mX1|Y$h=j$h=j ?</HnHnNB nJ(g =|"n$i=j$i=jJngnpnf=|?<)HnNypnfBgHnHnNB`?.?.?<?<Npnf N^`=| n0(h l$=|?<)HnNy n1|`& n0( h/.Nh-_?<(HnHnNB+o N,_+_JmVrmVgNJ-n n-h=|=|"h=i/.?<N.JTf$=|-mX?<HnHnNB`^=| BHn/< N-n n0!mT !mX1|Y/.Nh-_?<(HnHnNl=|?<)HnNyBgHnHnNB?<?.N` n|1n1h Bh nB( nph"f/.Na`2 nph Wrh"V0("H/Hm"-AN".g\/.N nJh f?<;"n/)Ny`;|x?<0 n/(HmlNB n/(BN^ _ NNAz n-h~ n~Y/(/<-HzN@ nz Ѩ (!@phg=|=h=h Jg&=|-hBgHnHnNB n~B=|U?<ND=_ n~=h ?<0HnHnNB=|-|?<HnHnNB-|?<.HnHnN|` nph"W"n")LWgl/<HnN@=|?<0 n/(HnNBX?<0 n/(HnNBY?<;HnNy n/(N|` nph"g ;|NJN^.NuNA/. NU-n n-h"npi"f$BgHnN4?<1HmBHnNB`NB-|=|?<HnHnNB n~J(gJhg^=h=|phg?<)HnNy n~1|=| n~0(H-@?<.HnHnNB n~Bh n~0(h l*=h=|?<)HnNy n~1|`0 n~0( hl =|?<)HnNy n~1| =| n0("H/Hm"N nph WgU/. NJg n=h`zJ.f /. N n/(N|BgHnN4 n=h Jh f?<,"n/)HnNB`?<1 n/(HnNB n1n `;|NJBn n1|"1nBh B(BB$N^ _\ONNA n n~=h=hBgHnHnNB?<?.N` n~|1n1h BhN^.NuNA n-h nphf phfpnRQ/.N=| np-@?<Hn"n/)NB n/(N|=|U?<ND=_Bn?<CHnNy?<8Hn1| /. NU-n n-h nph"fzJh f@/. B'NrBn n=h?<0Hn/.NBBg n?(N`0/. N?<0 n/(/.NB n /(N|` nph"f.?<0"n/)/.NB?< n?(N` nph"f?<0"n/)/.Ny nBh `f nphW/(Hzj-@N .-A n(g*pfR nB(Bh /.N` nphWJW-@(gB(1| `=|U?<ND=_ nJ(g?<%"n/)HnNB`v?<& n/(HnNB=|NB` np h"Wrh(Wph"W(Jh Wp h"Wg/. B'Nf``X nph f4/. N?<0 n/(/.NB n/(N|`?<4 n/(/.NBN^ _PONNA/. N޺-n n"hpi"f/. /.Nax` n"hpi"W"(4     HnN4 n=h ?<0"n/)HnNB n1|"1nB(N^.NuNA^-nb nb"h"iJfL0( @2;N   "n B`$ n /.HnfN:?<HnfNy` nb/(B'N nb/(B'N?<HnN4 nb"h"iJ)"gJh Vrh VgZJ.g?<HnNy`?< HnNy`VJ.g?<HnNy`?< HnNy`*J.g?<HnNy`?< HnNy`J-;gBJ.f n B nph f$/.Hn/. <.B'BN|`n/.Hn/. <.B'BNJ.f&Hn/<?<HnN4?<6HmHnNBBn nb"h"i3|"?<0"h/)HnNB=|?<0HnHnNB?<QHnNy?<0HnHnNBBn nb"h"i3|"?<0"h/)HnNB?<HnHnNBBHnB'HnfN:?< HnfNy nb"h-i^"n^3|"#|N n"n !Q n n /.HnN:?<HnNy/.N8N`D/.NU?< n"h?)N n /.HnN:?<HnNy` n/(NU n"h"ipi"V-;g"/(N޺?<T n"h/)Ny n"h/)N| n /.HnB$?<0HnHnNBHnN8?<THnNyBHnB'HnfN:?<HnfNy`X?<6HmHnNBBn?<0 nb"h/)HnNB=|-|=|?<HnfHnNB`0=|=| nb"h"i-Q?<0HnfHnNB-m nb"h"i3|""h-iN:?<HnNy`t n/(N޺ n"h-i"n0)"H/Hm"NJf n/(NN`@ n0( @2;N ` nR` nV n/(N?<Hm n"h/)NB n"h/)N| n /.HnN:?<HnNy`/.N޺?<T n^"n^3|"Bi ?< "h/)"h/)NBB nbJh f"n /.HnfN:`HnB'HnfN:?<HnfNy=|-|?<PHnfHnNBHn<HnfN:?<HnfNy nbph f("n /.HnfN:?<HnfNy`Z nb"h"iJ)"gFJh g>/(Ny n/(N| n /.HnN:?<HnNy`L nJf( n /.HnN:?<HnNy`J.f n P `N^ _ NNAn-n z nz-hv/.N޺ nvphm Bn` nvphm =|`=| n h0( nl/.HnN8?<QHnNyBn?<HnHnNB?<?.N nbJh g HnN8 nbJh Vrh Vg"n /.HnfN: nb0( @2;N "4F`F?< HnfNy`4?< HnfNy`"?< HnfNy`?< HnfNyBg nb"h"i?)NBg n?.N./. N nvph f/. B'N` /. N nvphfphW"nr*i Wgvpn RQ=| nvp-@"nJf?<Hn"n /)NB`?<Hn n /(NB nz/(N|`L nvphW/(Hz-@rN .rg nb"h"i?)N nb"h"i?)Nآ nb"h"i?)Nآ?<?.NN^ _ NNAJ.f/. /<N n PB-n n0( @2;NXXXXXXXXXXXXXXXX"h"i=ip hph"f /.N nvpfR n-hn nn0( @2;N ` nnR` nnV nvBh ?<0"n/)"nz/)NB n/(N| nz/(N|`| nvphWJWg"n"ipi"f /.N n-hn nn0( @2;N/.?<nWrnWgD/.NU?<T n/(Ny n /.HnN:?<HnNy`.pnf/./. .N`/.HnHnN n /.HnN:J.g n0( @2;N 0\?<HnNy`?<HnNy`J.g?<HnNy`?<N.`` nnT nv1| ?<0"n/)"nz/)NB n/(N| nz/(N|`/.NH n hJh fB nvphn/.?<N.` nvp hn/.?<N.`0 n hph f nvphn/.?<N.?<' n/( n /(NB?< n HnNy`J.g?<HnNy`?< HnNy`VJ.g?<HnNy`?< HnNy`*J.g?<HnNy`?< HnNy` n0( @2;N 0\?<HnNy`?<HnNy`J.g?<HnNy`?< HnNy` h?(N n /(N|`/.N n hJh fB nvphn/.?<N.` nvp hn/.?<N.`0 n hph f nvphn/.?<N.?<' n/( n /(NB?< n h?(N n /(N|?< nv?(NN^ _PON4     "n3|"#n B)?<;$h/*Ny nB n"h/)N|N^ _ NNAbJg-nf/< nfHh NJg nf0(Q@mr|nj@2;NL^zJ-7g4?<T .X//N -T-@jBrBnz?<HnnNy;|x?<;/./NJn f nfJnf n hpf^=|U?<ND=_=| n h h (T-@?<0HnHnNB=|?<)HnNy`0LH=n=| n h h (X-@?<7HnHnNB-n n 1|"1n1| |` n hpfb=|U?<ND=_f4?<HmlNy=|-|?<0HnHmlNB`?<; .м//Nj nf"hpf>=| .df-|` -|?<0HnHmlNB`&=| nf"h-Q?<0HnHmlNBHzLN` ;|x?<HmlNyHz4NJg nph$f-n=| n h h (T-@?<HnNyBn?<0HnHnNB=|`0LH=n=| n h h (T-@?<7HnHnNBpnf?<?.N n L?H?1n( n 1| HnXN| nJ(g n ph"gN=|U?<ND=_=|NA/. /.NN^ _PONNuNA nph"g nB nB$ nB( nph"g nB nB$ nB(p oJ o . Smn2;N0::::-n nph"g1|"BB(B$-n nb=| nb .Ш-@B.phf=|-m` =|BBgHnnN4?<,HnHnnNB=|-|rB.|B+|t;||+m6?<0HmpHnnNBBn?<0HnnHmpNBBg?.vNBJ-7g .jS/ -蚐j?N` nfJg /(HnHnNph"gBB(1|"B$ n1| ?<0/./.NBB nT nT`p fN-n nph"g1|"BB(B$-n nph"gB1|"B(B$ n1| ?<0/./.NBU nX nX`0?.. HnN(-n nph"gj nfJg"h-Q.gR .^JWg`U n"h/)Nb~Jg n/(/(N`ZJ-:g" n/(NU n/(NU` n/(NU nU n/("h/)<Nl8U n/("h/)<Nl8g n"hp*i f ?<!"h/)"h/)NB`?<Hn n"h/)NBHn/<N nB/.B'HnN: n"h"iJ)g0ph"f?<HnNy`?<HnNy`0 nph"f/(NU n"h"ipiW"hJQWg/(N޺ n"h"i3| U"h/)?<NJg ?<0HmB n"h/)NB` n/("h/)Ny n"h-i"nX$h-j$npjl0*H/&h/+N`?< n"h/)Ny nY"n?< HnNy`?< HnNy n"h/)HnHnNj ^ n"h"iri WJWg?<T"h/)Ny n"h"i=i /("h/)<Nm n"h"i3n JW"h"iri W"h"ipi"Wg?<T"h/)Ny n/("h$i/*N|`U n"h/)Nb0Jg$ n/(/("h"i//.Nb` n"h"ipi"f8/(N޺ n/("h/)Nax n"h/)N|` n"h"ipif/(/(/.N@`\ n"h"ipi f2/(/(Y"h"i/"h"i/N/)<Nm n"h"i3n -m n"hp*i f ?<!"h/)"h/)NB`?<Hn n"h/)NBHnB'HnN: n"h"iJ)g0ph"f?<HnNy`?<HnNy`0 nph"f?< HnNy`?< HnNym:B-: n/(/.N` n/(/(/.NhN^ _PON ASM_ASSIGNASM_XSETASSIGNNA n -n n/(NU n/(NU nph"W"h$h"*^ph"W"h$h$*]g"n B n Jgv n"h-i"h"i0("H$/("n?) )Nr n/(/.Nzn:B'NN n/($"n/)N U?<ND=_ n"h"i0.if?<?.N n"h"i$n0* i l/("h"i?) N. n/(N}=|-| nph"f?<Hn"h/)NB`?<PHn n"h/)NBHn<Hn6     N^ _PON ASM_MOVEL ASM_STRRTRIMNAD-nT nTphf"n"i&/)/. B'N `t nTphfr/(/. N" nTphl;|x0(H/HmlNU/.BgNJf/.HnhNx?<+HnhNyB'NN` nT0(|mް|Fn@2;NV(g6 nP/(Nu nP"P/)N|HzNB'NN`*?< nP"h/)Ny nP"h/)N|J.gD=|r nP"hEh#JB/(B"h"i/)?<"n/)NͬB'NN` n /(N޺J-(g& n /(NuHz~NB'NN`.+|t+m6?<0Hmp,zzzzv  f"""n -i"n "Q-i/.N޺/.NUJ-:g n h0($H-@Z| n (hf n-hP nPBh Bh B(X n n h/(NBB` n /(N޺J-(g& n /(N|HzNB'NN`4+|t;||+m6?<0 n h/(HmpNBB`B n -h nTphWrhWp'hW@0(H/HzN_J.gA@CSb`ACSp*h f/.Bg<Nr n hJh o/. n h?( N./.N} n hJh W n h(g-|lBnt?<HnhNy?< n/( n/(NB nB`x n hph"gb=|-nZ-nP nP-hL"nLpi"f;i $?<!HnhHmNB`b n (dW nTrhWphW@J.f,CESbU"n"i/)Nn=_f nTphf/.Nz` /.Nu n -P nTphWrhWgX;|x?<0HmHmlNB n/(?<N. n/(N|Hz\NB'NN n-P`?<!Hnh nP/(NB`B.J.g2-|lBnt?< HnhNy-|?<RHnhNy/.N޺ n hBh /.BgN.?<0 n/( n/(NB n/(N| n/(N|` n /(Nu n -PP nP/(?<N. nP/(N|HzTNB'NN` nTphWrhWgz-nPU"nP/)$Q/*NJf> nP/(?<N. nP"P/)B'Nx nP/("P"i/)N{ nP"P/)Nu nP"P-QJg B-nP nP-hLB.J.f$"nL-i$ipjf $i#j;|xJ.g?<0HmHmlNB`LJ. n /(NuHz:NB'NN`-n P nP/(Nu nP"P/)/NHzxNB'NN`n-n P nP/(Nu nP"P/)?<N. nP"P/)N| nP"P"Q/)?<N. nP"P"Q/)N|HzNB'NN` nT/(/. N" nTpNh_rRh\pGhgJ.f n-P`$ n P-P nL (Lf "n-QJg nTphVrhVg?<0HmHmlNB`fLH=m@-|;|x?<0HnHmlNB;|x-|?<0HnHmlNB?<0HnHmlNB`n nJgd nTphg?<0HmHmlNWrHhWgZ0(|G@2;N&BBBBB&BB4HzRN`HzPN`HzrN`` nTp=hWr>hWg>CTEZGSb$n$R<HQHR-IPN"nPHQN` nT0(|F@2;N\jjjjjjjjjjjj j CTEB`@LH=m@-|?<0HnHmlNB?<0HnHmlNBU nL/(Nb_U nL/(Nb~_U nL/(Nb0.@@J.gB.B. nP/(N޺J.g nL (DW"(HW"hJi W"h)Bg*"hpi gGSb$n$R<HQHR-IPN"nPHQN`HzN`B'NN`~-n P nP/(Nu/< nP"h"i"iHi N_J.g*/<HnhN@=|t?<0HmHnhNB nP"P/)N|J-(gHz`N` Hz.NB'NNJ.gLhH"nP/)$h0* R@?N. nL (DW"(HWg"nP/)N|`J.g& nP/(?<N. nP/(N|` nL (PW"(TWgB"nP/)BgN. nL (Tf"nP/)Nk nP/(N|`N nL (Lf"nP/)Nu`, nP/(N=n=|r nP"hEh#J/(B'Nx nP"h"i3| /(HnNy=| nP"hE#JB/(B"h"i/)Bg"n/)NB'NN`>-n P nP/(N޺/< nP"h"i"iHi N_J.g2/<HnhN@=|t?<0 nP"h/)HnhNBJ-uJ.f nL"h?)/.N n-P/./N nL (Lf"n-Q/./N`J-:g nP/("n"i/)<Nm nP/(?.fN. nL"h0)"H/Hm"NJfHn/<N nP"h$nLH5i/.N n h h/ n/(N@6     b`8 nTphfC"ESb`A<CSbATCESb<HPHn-HPN nPHPNB'NN`P n h h/(/. B'N `0-n P nP-hL|"nLp+i f"$ipjg$ipCLEGSb<HQHn-IHN"nHACSb nL (LW.gRCLEGSb<HQHn-IHN"nHNLN^ _PON256 entriescase table contains more than 2most case table entries address the same statementNA n -h n0-(hW"n"i$i*8gzBB.0-&EL-rJ.fB:BBB6B.B2BLB,0-,HH+@J,V-&-'g Hm.NN^ _PONNA<x/. ?<NU/. nHhnHnHnHnN_J.gHm?</. HzN n!mHmHz|N nJgRpf?<N.;|NJ`. np g?<?(N;|NJ`B.`|HmBHmNB?<pngB=|U?<NDlocation.NA J g-n -m. n+hD(VD@:(VD@8(VD@9(VD@;(VDr;A4J gb-h B'NN nJ( g&CHnn0(H/-IjN<"njAnESb/. /N`0/. /N`/N`/. /N``&=AҰnn$=@0.A&r0?N0.R@hp.&R@?N` BgNpmB]r?NJmBffBH n-h"n#m.|,+mT"h//-?<BgNb;|?<-HmNyJ-(g HzN`x+|T n-h"n#m.)@@,)+ ;|NJ+n. n-P `N^ _PONP_Listing abortedNA n+h0-m0+m.2"n;iB0)R@;@@pif i87`B-7 n"h )VD@:"h )VDr;A4N^.NuNAl n"h"i piWU"h/) -@pNb~ .pg n-hlUBgND)*gJ)+ftEHn~0)6H/-JzN<$nzA~CSb n"P/<NHm/<NHmj/<NHm/<NNUHm^Hn\HnHnHnN_AC\ESb nZCSbB-N^Nun:EXEC.CODE") ? OVERLAYADDRESSOutput file (d22U@bYN-_HnHnHz,NHnNfpN n!m,-n N^.NuDNA n0C22U@bYNt-_HnHnHzRNHnNfp-m, nJV"(PVg ?<}N. n!m,-n N^.NuDNA n 0C22U@bYN-_HnHnHzefault is "Invalid file name. File ? J`f Hm\B/@2;Nnn^~~Z > > > 2 2 2 2 2 2 2 2 2 2Nc n!_N3lN^NuNAYN+_,-m, n1|* BP"n!i "nLHC-I"nJf$i0mа|n@2;NNHi/<N n-h"nC-I"n$n&i4&iL H `p n-h nHh"n0<i 2< @RAlRAAH/ 2 2 2 2 2 2 2 2 2 2 v v 2 2 2 2 2 2 2 2 2-m,"nJgU/)N۾Jf ?<}N.-n m,"n#hB. m,p*h f nJhf3|* BQ|E-J )DfV/-/Hz.+O$n&m, +lDNv%@+o N,_+_pmf ?<N n"h2"n$h5i Hi $hHj 0) H/N`N3lN^.NuNAYNP+_,-m, n1|$ 0"n!i !nN3lN^.NuNAYN+_,-m, n1|) 0"n!i !n0-CH!qN3lN^.NuNA n-h"n3|+ 2#m-N.` n (Lf^J-lf ?<2N. nBHh/<N n"hBQ"m,"i/)/) JWlW"hLH ` nB"nB`pm W m,(gz/-/HzP+O m,/(/N-_| n1|* BPC-I"n#n+o N",_+_D$h#j YHjN-_pmf N3l` ?<N.p(mffp mfYBN n!_`>p mfY/<N n!_`YBN n!_?<}N.N3l`YBN n!_?<}N.Y n hHhN~-_pmf N3l` ?<N.Y n hpmf?<-N.`NJJ.f2 n0!m,"npif 1|" ` n1| `-m, nJV"(DV (HVg ?<}N.-n n1| 0!mP!m,"m,p*i fj"m,C-I"nJf?<}N.`F nJ] ^g?<}NHhB'N-_ n"h""n""n"N^.NuNA n-h"n3|+ 2$h#j #mXYHjB'Nl n!_"h-i"nJQWJVg0$ipjf?<}N.` -R/HzHNLpmg n"hB`$N3lY n hHhN n"h"N^.NuB'.` n1|* BP"m,LH`-m, nJV"(DV (HVg ?<}N.-n n!mT"m,p*i f6BP1|* C-I"n$m, *<r#A` n1| 0!m,`@-m, nJg("h0)H/HzPNJf ?<}N.ADDR' of a constant may not be supported on other implementationsNA n-h"n3|+ 2#mD$h#j YHjBgNh-_ n!npmf N3l` ?<N.Y n hHh"h p/iWN n n-Ppmf N3l` ?<N.Y n h-n n!mD"m,p*i g1| 0!m,` n1|* BP"m,LH`-n n!mDB."m,Jg~U/-,N(Jf?<}N.`` m,p*h fR m, (Pf n!||`, m,-h npPf"n0( H#@|J.f n1| HhN n n-PpmgY/ n ` N3lY n hHhN n N^.NuNABBJmfF/:HnNX nJhf, n-h .hf ?<}N.N3l`Hn n hHhHzBNHnNB m,-hB m,p(h f m,-h0!m,` n1|* BP|`-n n!mD1| 0!m,"m,Jg~U"m,/)Nb~Jf?<}N.`Z m,pPg?<}N.`@ m, (hg0 n1|* BPC-I"n$m,$j0*$H#@`8-n n-h "n3|+ #h 2$n#j Y` m,p)h f m,-hJV-Ag@ nphf2 nJ(g?<}N.` nJ(g ?<}N.Jg>-n n-PJ(g ?<N. np hf -h`B` ?<N. n hHh/.HnN n-h"n3|* BQ#mD|#nHhN-_ n!npmf&N3lY nHhNߚ n n-P``-m, nJg (Lg ?<}N.-n nphf"n3|# ` n1|! n0!mD!m,`T-m,-|-| nJg^-h"npil?<}N.`< nph9     $n0*|?@2;N ,lL&n/+/+ NLH` n/(/( NLH`~ n/(/( NLH`^ n/(/( NLH`> n/(/( NLH` n/(/( NLH+o NN,_+_pmWr nJg n-PRn`0.R@HS-@ n .İo n-h .=@0. @mH=@0.H/ nHhNJg 0.H2.HҀR n!A ` 0.S@h n!n+n,N^ _PON@@NAYN+_,-m, n1|$ B0!nN^.mWpm\tm_g?<2N.LzH`NJ n1|* BPB("h!i"hLH n"hBQ`Jg ?<~N.+n, m,p+h f m,-h`B m,Bh Jg6 m,"n"i0) h o n h"m,3h n-P` nphf\YNuNA n 0C22U@bJ-g ?<^N.Jf2HnHnHzNHnN8zpmfN3l`^ nphfHn/.N4`@?<N.HnHnHz8NHnN8zpmfN3l/-.NN^ _PONNAYN+_,-m, n1|$ 0"n!if/(HnHnNj` n/(HnHnNjB. np*h fC-I"nJgr/-/HzH+O$np jf )RNv-@` n (SNv-@|+o N",_+_pmf?<-N.`NJ-n m,"n#hJ.gH3|* BQA-H n!nN-_ m,"n" m,!nYN̂ n!_ n-h n01|$ "n!i&$m,!jN^ _PON ;STRPOS does not conform to HP standard, see $SWITCH_STRPOS$NA n 0C22U@bN3lJW@J.gTHn/<N-n n .]".^g ?</N.`6 n0"np if 1| ` n1| n!m,`/N`/N`/Nj`/N`-n n1|+ 0!mD"n!i $np$jf2?<N.J.gY nHh?<N n!_`Y nHh?<N n1|BB(B( 1|B!|Hh HmNYNh-_-n n1|, 0!nB(BBBB=|=|B.B.pmgHnHnHz,NHnNfp-m, m,-hJgJ.g nJhg?<N.`| n!nB. .ⰭDV".!_`-n n1|+ 0!mD"n!i YHiNܘ n!_B."h-i"np*i W)Ag6-i$npRf$j Hj Hn0* H/N|J.g/-/Hzz+O n0(| @2;N*HnN-_`"HnN-_`HnN-_ nHVgT/.HnHnNj oo?<N.`(-n n!npЮlмT `&U/. n/(NhbJf ?<N.p3mfHN3lHnHnHzNHnNfpU/. m,/(NhbJf ?<N. np*h W m,r*h W.@g n1|* BP|!n+o N,_+_J-lg ?<2N.`-n n1|+ 0!mT"n!i J.gH$np)jfYHi?<N\ n!_`Y nHh?<N> n!_`HYN* n!_J/.N߬HnNx`*/.Npmf mN^ _ NNA-m,| n"h$h0* i 1@ "h-i"h-iJWJWg B` HnHz HnHz n0(H/N/ n0(H/NNHnHz XNJg?<N.`d n0(@2;N ""npifR"n3| U/.?<N.HnNP`N^ _PONNA-n nphg?<N.`" nphfJ(8g ?<N.Hn/<N-n nB(B( 1|Hh HmN n "n#h n phf 3|` n1|YN+_,-m, nBP1|$ !n!n N3l/.NhbJg$ n"n )o n!n` ?<N.`U/.NU/.Ngn .g^U/./.N(JfJg n1| "h#n` .DV".HV .DV$.HVg?<N. n!mD n"hp*i f"hJf?<,NHnNZ` np h$W-g:YN+_,-m, n01|$ "n!i&!nN3l`. np h$g ?<gN./.HnNHnN`:J-g/./N`/.HnNHnNٰ` /./Nb-m, nJg&"hpiW-Ag "h!iN^.Nu.` nph W"hr*i Vg4/(Hn/NJg n1| .D"h#@`6 nph f("hJl?<}N. n"h#|` n!mL .g$UHh/(N:Jf?<N.B. n .g$UHh/(NJf?<N.B.`0 .NA n 0C22U@bN3lHn n/(NE-m, nJV"(TVg ?<N. npPW2( H/Hz-@N .gn n0( @2;N "0>L1| `B nBh `6 n1| `( n1| ` n1| ` n1| `YN-_-nTV".TVg?<N. n!mT n"hp*i W."hr*i Wg"h$h)*gB"h-i"h-iph f6J-lf ?<2N.pWrWp-@`/-/Hz+O n0( |@2;NH/./.N-_`VJf?< n!mT"m,p*i g 01| !m,"h1i `BJ-lf ?<2N. nBP1|* C-I"n$m, *SlD#@+n,N^ _PONNA n 0C22U@b0-H/HmNJfJ?<:N.HnHnHmNHnN8z0-H/HmNJf YN,N.`/./.N-_`*Jf?<,N.`/./.N-_+o N",_+_pmf?<-N.`NJ n1|* BP1| C-I"n#n`6 n (LW-lrm Wg/-/Hz+Oph f6"h"i/)/) "h"i/)/) N:     "h2N^ _PONNA-m, n"h$h0* i 1@ |"h-i"h-iJWJWg B`HnHzHnHz n0(H/N/ n0(H/NNHnHzNJg?<N.` n0( | @2;N"npiffU/./.`" n"hJW"h)g+h,`N^.Nu0NA n 0C22U@bB.p'mfd0-H/HzHNJgL|pmW@.@@N3lB-p"mWr#mWAHnHnHzNHn/N"h"i/)/) -@N .g n+h,`Hm Wg/-/Hz+Op h f6"h"i/)/) "h"i/)/) NLH`6 n"h"i/)/) "h"i/)/) NLH+o N:,_+_pmWrmWg?<-N.LpH`NJ n1|* BP1| C-I"nBHi/<N n"h"iJQW/:/:"h"i/)/) -@N .g n+h,` n"hJ)g"hpf+h,`H n"h"iJQW/:/:"h"i/)/) -@N .g n+h,`D n"hJ)g0"hJf +h,` n"hpf+h,`N^ n"hLH n"hBQ` n"hp*i W.g0( | mt|nl@2;Nz````"hJ)g"hJf+h,`H n"h"iJQW/:/:"h"i/)/) -@N .g n+h,` n"hJ)g."hJf-h1| !n.Nu?NA n 0C22U@bHnHnHzNHn/N>p&mW-lA-g ?<^N.p&mfYN"-_=m-n0-@2;N 4& n1| `( n1| ` n1| ` n1| m,"n#h2#m,N3lHn"n1i `^ n"h"iJQW/:/:"h"i/)/) -@N .g" n-h1| !n"n1i `L n"hpW"h)g +h,`" n"hJW"h)g+h,``l n"hp*i W.gT0( | mH|n@@2;Nz4444HnHz n0(W@m||nt@2;N<hZ,hLL n0( H/Hzh,_+_ n!| nC-I"n--눁-툁0-v爁-鈁-.g| nB -n N^.NuNA n0C22U@b nBYHnN -_ nJf n ` n P n 0-H/HmNJfpmV@NJf ?<N.`. n0( H/HzBNJgv n"hJQW"hJQWgX=h 1|* BP|"h$h *fJnWr!A`pnW nr!A` ?<N.` n0( U@mB|n:@2;N  1| ` n1| `?<NpmfN3lJ.gN^ _ NNA n h-h"n$i-j$i-jJVJVg/<$nHj NJg ?<N.U/./.NhbJg$ n"hp*i f/./(Nr`fU/.NLU/.NBg(U nHh/.NJf ?<N.`$U.``>U/.Nb0Jf ?<N.`?<N.`?<N.` n"hp*i W"hr*i Wg"h$h)*gJ-lf ?<2N. n"h-i"h-i=h 1|* BP1| C-I"n0.@2;N &Db .]r#A` . n/(/.NJf ?<N.N^.NuNAYBg<Nf n!_-hHnHhHzvNHn/. NԦ n!m,"m,pQg ?<8N.pmg?<3N.`$N3l nHhN n!m,/NhN^ _PONNAYN n h"h#_"h-iJ. g$Hn"n_ nr!A`v .^ nr!A`X .\ nr!A`: .W nr!A` .V nr!A`d n (LW-lgN"h"iL H n"h"iL H nC-I"n0( @2;N 2HiHzNHnN\` Hn nHhHzNHnN n!m,"m,-iJg"npiV"m,JQWg?<N.`pmW. g nHh"nHQ$n/*N`jpmW. Ag> nHh"nHQ$n/*NVpmf N3l` ?<N.` nX~/./././.N np!@`/./././.N np!@`/./././.N np!@`p/./././.N np!@`J/./././.N np!@`$/./././.N np!@ n1|* BP1| `h n/(Jg ?<~N.N^ _\ONDNAY nHhp8hWN-_ n h"h#npmf N3l` ?<N. np8hfYHhNd n `Y nHh<N* n n-Ppmf N3l` ?<N. np8hfYHhNb n `Y n;     "nHi/<N n-h"n#m,$nHj/.HnNfY/.N" n N^.Nu0DNAY n hHh. N\ n!_"h"i!iJgf"hpig?<}N. nB`B n"hJ)f?<N.`$ n"hJ)"g?<}N. nBN^ _ Hn nHhHzNHnNR m,JgT m, hp hf n!m, nphWrhWg"m, )dW"m,"iJWg ?<}N.pmg?<N.`8N3lY nHhN: n n-P nphW@` nphWrhWg?<}N\ONNAY n hHh. N n!_YNx-_-n n1|% "n$i!j$i%n$h0B$h#jJg8$ipjg?<}N. nB` n"h$n%ipmf N3l` ?<N.Hn n hHhHzNHnN n!m,"nJg.`\ m, (dV n2(H/Hz-@N .g?<N.` m, hJf ?<}N.pmW@J.g*N3lHn nHhHz2NHnN`( n0(H/Hz2NJf ?<N.`| nphWrhWg6J n"P#_"P-i"n#mhBQ3|* B)Hi/< N n-h"n2Bi N^.NuDNAY nHh?<N n h"h#_pmg ?<,Jg/./<N n-P n!m, m,-hJg nphf n-h .DV".HVg ?<}N.pmf N3l` ?<N.YHn nHhHz$NHnN< n N^.NuDDNAB nphg$Hn/< N n hN.N3lY nHhN n h"h"i"N^.NuNABBJmf/: HnNXHn nHhHzNHn/.N̐ m,Jgd m,-h nphfBJg6-h"n-QJ)g ?<N. np hf-h` ?<}N.` ?<N. n h-h"h#n nJ(fphf6J-n n0Hf||"n#n` n-h`Jn^.AgSn0.AF00H/HzNJf0.AL-p0.p*i W)g"J] ^g ?<N.`YN n n-P .RhZnpmW@J.g&N3lHn nHhHz@NHnN`LB-Jg nBN^.Nu@ ddddNA-m,U n/(AFrpgRJV.Ag>-n n0Hf| |"n#n` n-h`JnW.2.AFtpWg0J.f ?<N.N3lN^.NuNAY?<B'N n!_N3l n"hHiHnHnHhHz4NHnN܎p mNb0JfH n (PW. r*h WgHhHh/<Nc` ?<}N.`< n"hJ)"f,"h/)HnHnNjpg ?<}N. npPV. Ag ?<}N.N^ _\ONNAYBg<N n h!_-hYN n!_-h"n#mh3|' f N3l` ?< N.N^.Nu@NAY?<<Nh n!_N3l n-hHnHhHzNHnN n!m,-m,"nJV")TVg ?<N.p mf N3l` ?<4N.YHn nHhHzXNHnN n!_p mf$N3lY nHhN<     V")TVg ?<N.pmf N3l` ?<6N.Y nHhN n!_N^.NuNAY?<<N, n!_N3l n-hJmg4?<N.Hn nHhHz&NHnN8zB`/:HnNXYN n!_-n-h"n3|$ $n#j 8J\\\\\\\\\\\\\\\\\\\\\\\\\\\\\&/:JHnNX-n nphWr h$WphWgHn/./N` /./NΒ`/N`Rm/N|Sm`xRm/NSm`f/N`\Rm/NHSm`JRm/NSm`8Rm/N2#npj$V2*m(Vg ?<N. nJgj"hpil?<N.`N/< nHhNJg?<N.`& nHhHnHhHz$NHnNN3lpmg0?<3N.Hn nHhHzNHnN8z`N3lHn nHhHzNHnSm`&Rm/NSm`Rm/NSm`0-H/Hz\NJf?<N.HnN8z`Y?< B'N4-_ n!n -n N^.Nud @NA0.n o =n`=n N^ _PONNA n 0C22U@b-m/-NJgz/-/ n!_` nBN^.NuNA n h-h"nJf#n #n $n B` n -h B n-hJg, n ( l-n n-h```Jf n!n `& n!n  n (m ?<N. n !nJf n!n `Nn n!m,U"h/)"h/)NhbJf?<N.`& n"hp*i f"h/)/(N(0-H/HzdNJf0?<7N.Hn nHhHz.NHnN8z`pmf n1|"` n1|"N3lHn nHhHzNHnNψ n!m,U"h/)"h n "n ) n ?<N.N^ _PONNAY?<<Nb n!_N3l n-hHnHhHzTNHnN n!m,"h-iJg"npil ?<N.p mf N3l`,?<N.Hn nHhHzNHnN8z nBBBh*Bh,B"B&B/)NhbJf?<N.`& n"hp*i f"h/)/(N(pmf N3l` ?<6N.Y nHhN n!_$Jg* nHhHn nHhHz NHnNN^.Nu   NAY?< <N϶ n!_N3l=m& n0-H/HzNJfB-lHn/<N-nHn nHhHzNHnHnHnNH U/./.NhbJf ?<N. n!n p3mfN3lJ-g ?<^N.Hn nHhHzNHnHnHnNH U/./.NhbJf ?<kN. n!n ( -hJmg0?<N.Hn nHhHzLNHnN8z`/:8HnNXHn nHhHz"NHnN m,-hJgt np hg?<N.`Xpm&n?<N.`@Rm&0-&ABA-H n"n"3|#n n!m,pmV@J.o?<fN. n!h ` n!h  n -n/./N nRh*pmV@pmfN3lJ.g|lpmf N3l` ?<N.YHn nHhHzNHnN -_ nRh,J"f !n"` n -nJg-n n!n-P`pf&N3lY?< B'NΈ n!_ n-hJ.gpmf N3l` ?<6N.Y nHhN n!_;n&N^.NuBBNAY?<<N n!_N3l n-hR"nHiHnHnHhHzPNHnNϴSp9mf$N3lY nHhN n!_mV@pmfN3lJ.gp2mf2J-g ?<^N.N3l nHh&Hn"nHiN(p mf N3l` ?< N. nJh*f ?<N.N^.Nu`@ @ ```NAY?<B'NԼ n!_N3l n-h"nHi` ?<N.N^.Nu@NA n0C22U@bBp"mf 'o ?<N.=m&0.AF00H/HzNJgSn`0.AL-pJgr-n n0HfPJ(g?<N.B`. n|JmV( g ?<N.HnHnHhHzNHnNhp mfh -R n!@J-g|N3l nHhN n!m,-m,"nJV")TVg ?<N.` ?<5N.N^.Nu NAY?< <N n!_N3l n-hHnHhHzNHnN҈ n!m,-m,"nJ n!m`` n-h`?<N.N3lpmf N3l` ?<N.0-H/HnHnHz&NHnNJf?<N.HnN8zpmfN3l0-H/HnHmHzNHnNJg0-@2;Nr\\\\\\\\\\\\\\\\\\=      n PHP??NHnHnHnNH .DfJ_ ^g?<NHnNX|N3lJWrmWg| n|Jg "h#n n!n"h Jf "h "/.HmNd/.N\(pmf N3l` ?<N.Jmf/:HnNXN3l`,?<N.Hn nHhHzNHnN8zJg n-h `BHnNJf(?<N.HnHnHz@NHnN8z`,pmf\N3l0-H/HnHnHnNHnNJf(?<N.HnHnHnNHnN8z` ?<N.-nB-nJg-n n-h!n0($Y@@2;N^^66 YHn/(.-|Hn/<&N mh"nL?H?3h$$-n n1n$Hh "nHiN .R n ` ?<N.pmf N3l` ?< N.`HnHnHzhNHnHnHnNH Jg nJhg?<kN.BHn/<N-n n1|Hh "nHi <?<NK n!_`YHn n/(&<?<NK n!_`YHn/-X<?<NK n!_`dYHn/-h<?<NK n!_`@YHn/-X<?<NK n!_&J g<"h pig$YHm./( B'?<NK n!_` n!h&` n-h JN nB(Jg"n "n1i!n` n 1|B n!np3mf N3l` ?<N.HnHnHnNH -nJg0 n!nJV"(Vg ?<kN.` n!h n (o?<fN. n!h n/(HnHnNKJ ng nphf n-h nJg8"PJ g. n-PYHn"n/) <?<NK n!_ nJgR-hYHn"n/) <?<NK n!_"nJgYHn/( <?<NK-_ n-h`8`-n-n` n .ʐlD-@ .-@/(HnHnNKJ0.ڰno=n.Հ.gRnp no\ n|1n.Հ.@ ( @rnpA\"(DWg !mH` nB( n 0-H/HnNJf?<N.HnN8z` n BN^ _ NDDJg pѮ n ` nB nBN^ _N`<t   NA n0C22U@bHn/<N-n n1|BHh HmN nB(B( 1|Bpmf-m.BNA-n nJho 0(P@S@l^@@HШ"n"` n"n" nB(pW"nriWg 1|` n1| nJWr h^(@g"n|B) 3h` nB(N^ _PONNA-n nJ fBB(`< n h"n$i (.=m&pm&o>Rm&0-&CBC-I"nB3|BBB B` ?<N.pnf"HnHzT nHhHhB'BN`HnHz8 nHhHhB'BN+n.;n& n N^ _ N0NA n0C22U@b0-H/HmpNJf(?<N.*gJJhf. (=@Jng0.H0.H1@/-/HzR+O n h"n$i 0*hNvr @lTNvhNvJhlBh`+o N2,_+_pmf ?<N. n hBBh`NJ n h"n#h|3h $i 0*hJi Wri WHnHnHmpNHnN8z0-H/HmpNJgpmf=m&0-&AF00H/HzNJgSm&`Hn/< N-n nBh 1|B(|B( 1|Hh "nHiNBBnN3lJmfHn/< N-n nHPHmNd n$i pjW$i * g0) l^@@HѩB)| n hpho1|` n hJhop/-/Hz.+O0(P@NvS@Nvl^@@HѨNv+o N.,_+_pmf?<N. n hB`NJ n hBh nB("n"iiYHi/( <?<NK n>     JgF nphm. n!n n!nJ.g/./.N` ?<nN.`,?<N.Hn nHhHzVNHnN8z n"nh/./(Nxp mf N3l` ?<N.B n h-h-h=h=hBHn nHhHzNHnHnHnN /./N n-h`pmfFN3l0-H/Hz|NJf(?<N.HnHnHz`NHnN8z`pmf /N` nBN^ _N``@p@NAHn/<N n"h"-n"nB3|B)B)"H nJg*U n h/( /.NhbJf ?<oN.Hn/<&N-n n!n!nB"!n1| Hh HnNp3mfvJ-g ?<^N.N3lHn nHhHzNHnHnHnNH nJg*U n h/( /.NhbJf ?<oN. n!n3|Hi HhNN3lJmfLHn/<N-n nHPHmNd n!n !m"Bh+n"N3l` ?<N.N^.NuNA/-/Hz*+O/. n/(N-_+o N:,_+_pmf*?<N.J g n phf n BN^ _ NNAN n (o ?<fN.-n-npmV@J.fN3lJ.gpmf N3l` ?<N.pmf N3l` ?< N.pmf B` nBHnHmNHn nHhHzNHnHnHn nHh/(N-nJg0 nJ"f3lpmf N3l` ?< N.BHn/<&N-n n!nB"ni$B(B( 1|B(!| 1|Hh HiN nB("-nHn nHhHzNHnHn/.NJgB nphm* .Df?<N.` n!n` ?<qN n"n#h""n-i```/<HnNJg ?<N. n/(Hn/(HnHnHzJNHnNHnN n h0(l^@@HШ-@0.l^@@HЮ-@0.@2(AA]".W".^g-h=hJg. n-h n!n.pmV@J.fN3lJ.gpmf N3l` ?< N.p mf N3l` ?<N. nHhHnN̮-n n-h!nJg ?]?@J.g .-@/< n/(/N`J| nJh f B`0 np =@0.S@HЮ/0.H/N-_`n nJf(?<N.HnHnHzNHnN8zJmf8|BJmf nJ(gHn/<"N`Hn/< N-n nHPHmNd nB B1|B(Hh"nHiN n Jf n Jg n!n-nJf-n/.N\(N3l`"hJ)g B.`&/</.N n ( _@J.g n/( /.N-_ n/( /(/NJ.g n B(-n-nJf n"h"N^.Nu`@NA n 0C22U@bB.HnHmN0-H/HmzNJf(?< N.HnHn ?<N.0-H/HzzNJf(?<N.HnHnHzlNHnN8zpmV@J.fN3lJ.gpmf N3l` ?<N.HnHnHzNHnHnN̮Jg8/.Hn/.Hn nHh HzNHnNHnNJg(-n n!nHmzNHnN8z0-H/HmzNJg0-H/HmpNJgHn/./Nt`Jpmf /NX`6p*mfLN3l|0-H/HmNJf(?< N.HnHnHmNHnN8zp+mf /N*`p,mf N3l=m&pm&o,Rm&0-&>     AP p P!m"+n"` n"m""i #h  m"+h"`ACSb|N^ _TONUndefined type NA n0C22U@bN3lp"mg?<N.`0-&ABA-H n-h B.JV.Ag2 n0Hg n-h-@Nb0 .Ag ?<2N. n1|$ nLH& .ⰭDgpmfN3lHnHnHzNHnHnHnNH .ⰭPg?<2N.`p.|Lm|'nz@2;NPnnnnn`TnnnnnnnnnnnnnnnnnnnnnnnnPn`|?<N.`J.f\Hn/<N 'o ?<N.-n n0"n!i B(B(B( 1m(B(#n N3l0-H/HnHnHzNHnNJf(?<N.HnHnHz`NHnN8zpmV@J.fN3lJ.gpmf Nnnnn`T`& nBh$` n1|$` ?<2N.pmf N3l` ?< N.` ?<N.0-H/HnHnHnHzNHnHmNHnNJf:?<N.HnHnHnHz`NHnHmNHnN8zpmV@J.fN3lJ.gpmABA-H nBBh` ?<N.BBn=|BHnHnHnHzNHnHzNHnHnHnHn/N^Hn/<N-n0-& nCB!q!n/./NZ n1| Hh HnN;n&p mf N3l` ?< N. n `p)m3l` ?<N.N^.NuPPNA n 0C22U@bN3lJmg(?<N.HnHnHznNHnN8zJmfNHn/< N-n nHPHmNd n+PB B1|HhHmNN3lp(mWr mWg N3l` ?<N.HnHnHzNf:N3lp mf N3l` ?<N.HnHn/NJg< nphl?<sN.B` .Df?<N.BHn/<N-n n!n1|Hh HnN nB(B(B1|B!|oJg^/.HnHnNjJ] o^g?<HnHnHnNH JgJ-g$ .XW-Ag ?<^N. n0(H/HzNJg-nJ-g npPg ?<^N. npPfB(J. f ?<N.J-g +n>`D nJ(f"J.f/.N.`( n!n!npЮlмT n `dp-mf$N3lHn/<N-n nB(B(1|1| Hh HnHnHzTNHnNp mfxN3lHn nHhN nJgR"hJ_"h ^g?<N.`*/< n"hHiHnN n|J-f n+hB/.N\( n!n nLHpmf\N3l0-H/HnHnHz\NHnNJf(?<N.HnHnHz4NHnN8z` ?<N.`N^ _PONNA n0C22U@bN3lJm NJg ?<N.`J-f ?<_N. nB nJf ` n"h <Б n `8pmf.--f ?<dN.N3lHn/.?<N0-H/HnNJf?<N.HnN8z` nBN^ _PON`@NAACSg(?<N.HnHnHzHNHnN8z;m&JmfHn/<N-n nHPHmNd nB BhHhHmN n+P N3lp(mWr mWg N3l` ?<N./.N\(HnHnHzNHnHnN n!n pmf\N3l0-H/HnbB-0-&AP p P-hJg n h (\f n PCASb/:HnNXJfJJ.g>?<uACESb"n"QNz n"PEpR@ fdS@f .Ⱝdg?<N.`B .f n-h` n"n#h-nJ-f /-8N\(`&YHm./.B'?<NK n!_-n` YHm./.B'?<NK n!_ nJfjJgZJV/<"nHi -@N .g20-&HnN8z` nJ(f ?<{N.N^.Nu0NA n0C22U@b=mBr|N3l-m.B.| |!HnHmNHmHzN=m(=m&pm(o Rm(` ?<N./Nt-nJrV n@(.g ?<lN. nJ( nCH!q0-&AH!B` n-h`pm(W .]g ?<N.pmf\N3l0-H/HnHnHzNHnNJf(?<N.HnHnHzZNHnN8z` ?<N.JmV2-H/Hm-@N .Agg !mr ` n!m J-mf pmf N3l` ?<N.B-J-mg&J.g?<N.` n|(`JmWACtRB f SBfr`Bp6mWgphW"hriWp hW"htiWg ?<N. nJ(fphf,Hh/<=N n"h3|"hB)8`2 nHh/<=N n-h"n3|B8B)< n;n(;n&+n.HmHnN| pmf N3l` ?<N.0-H/HnNJf?<N.HnN8zN^.NuFORWARDEXTERNAL/External declarations will be treated as globalNAJg-n n0(H/HzNJgX nphfJ(8-h"nHQHmNd nB B$1|B((B()mm+B(,B(*B(-B"n1iHhHiN n/(N\(`R n"h-iJg<-n nph$fYHm./( B'?<NK-_ n-h`N3l`?<N. n!m6pm&oRm&0-&ABA@((g:?<uCEPGSb$P<HQHR-IN"nHQN n/(Nr n/(NfN^.Nu Missing procedure NA n0C22U@bHnB/`B'NB'Np1mfbJ.g ?<N.N3l/N`pm&Vrm(Wg*.gS/-/./.N -.Ѯ`2J.f ?<N.p mf N3l` ?< N. n"n#h#m. +n.+n>;n&HmHnNnmpm(f(+npm&W.HmHzNHnNJgp n"hB)-J(g "hB)-;n(+n.pm&f<N n/(/N0-&AT-pJgB-n n"PJV"P")\g"P"i$P%i` n-h`+n=m$N^.Nu@@@@@  Ag /-N| J.f n| n"n !Q n -nJg n-h Jg-n n-PJ.fV"nJ) fF?<E&Q&SIGSbB>HmHzNB.Brp.mf N3l` ?<N.Jmg"?<Ppmf.N3l0-H/HzvNJf ?<N.`pmg ?<N.` pmf N3l` ?<N.+n n+PN^ _N@@**undefmodule**: needs concrete instanceNA n0C22U@bpmf HnNˆpm(f /-N.ACSb`p-d ?<N.0-&ABA-H nphf/(/N`F n/(/N n-hJWJVg n/( /N| n-h`JW@pm&o>Rm&0-&ABA-H nBBB B1|B` ?<NJ-gpmfHn<B'Npmf HnNϪpmf HnN,pmWr mWg<NɼHnN`0-H/HzNJg ?<^N.0-H/HzNJg0-|@2;N8JVb:bbHn<B'N.Hn/<NJ.gHn/<$NHn/<=N-n nHPHmNd nB BHhHz N n1|1||+B(B$B()B(-|(B(,B(*|81m(-n n B|B( B BBB(B`Z m-P n-P-n nJ( N `PHnN`DHnNZ`8<Npm(f0-&AB/0N0-|.@2;N:jHnB'B'0-&ATHpB'N``N3lHn<<0-&ATHpB'N`0N3lHn<B'0-&ATHpB'Nz```pm(Vg ?<N. n0-&CH#+h .| |!pm(f-m n+PJ.g n!m -n n BBB "n!i-n0-&ABA-H n!n"n#nJmfN3lpmf N3l` ?<N.pm&W.AgB'N-Ag?<dN.`J-g ?<^N.N3lHn0-&APHpB'N(``<0-H/HzNJgN0-|@2;N8Tj6666666666666666666?<N.Hn<B'NP`?<N.HnN`?<N.HnNv/-NB-p/mflpm&W..Ag"|/-N|0-]@;@N N3l n"n"Hn$nHjB'N n"n#P nB"n|J.gF/.N\(Sm&Hn/<=N n"nHPHQ/<=N/.N\(Rm&p0mfvpm&W-A.`<NHnN*`?<N.N3lHn0-&APHpB'N4`r<N?<N.p.mf(HnB'B'0-&ATHpB'N`,N3lHn<B'0-&ATHpB'N``<N^pmg?<N.HnN8zB- B-!Bm0-&AB.@-Ag"|/-N|0-]@;@N N3lHnHnHz>NHn/NZ`J.g ?<N. nB("n$n%QB.@-rm&Wg N0B-pm&W.AgFJ>g>-m> n"hJ)f/HhN n"h| n+h/0Nݺ0-&AT-pJgh n PJ( fN?<A"n"Q"Q"QECSbNd nHhTHzNd nHhXHzA      nHhHzbNd nHhHzBNd nHhHzNd nHhHzNd nHhHz$Nd nHhHzNd nHhHzNd nHh0HzNNd nHhHzDNd nHhHzNd nHhHzNd nHhHzNd nHhHzNd nHhHzdNdN^.UNITWAITNEWWORDSSTRLTRIMSTRRTRIM UNITCLEAR STRAPPEND STRINSERT STRDELETE ESCAPECODENAp/NHn/<&N mh"nL?H?3h$$ n1|$ n =|8Rn0.H/HzN_J.gHn/<N`Hn/<NBB0.|9@NuABSCHRODDORDSQRHEXNEWEOFPREDSUCCADDRCALLPAGEREADOPENSEEKEOLNHALTPACKSCANROUNDTRUNCOCTALWRITECLOSERESETBINARYSIZEOFPROMPTREADLNAPPENDMAXPOSSTRLENSTRMAXUNPACKLENGTHCONCATGOTOXYDISPOSEWRITELNR2;N:LJpJv^v/-X?</N`/-X?</N`-mT/-D?</N`/-D?</N|`x/-H?</Nj`f-mD`\-mL/-L?</NH`D/-`?</N6`2/-D?</N$/-X?</N`/-D?</EWRITEREADDIRSTRREADSTRMOVELINEPOSWRITEDIRSTRWRITEPOSITIONUNITREADMOVELEFTFILLCHAR OVERPRINT SETSTRLEN UNITWRITE BLOCKREAD MOVERIGHT BLOCKWRITENA /NL=|Rn0.H/Hz0N_J.gHn/<N`Hn/<N-n0.N/-D?</N/-h?</N`/-D?</N/-h?</N/.?</N`-mD/.?</N/.?</N`-n/-D?</N|/.?</Nn`j-n/-D?</NV/-D?</NH/.?</N:`6/.?</N(/-h?</N`-n/.?<H nC Bp2ng B `H nHh /<&N n"mh$h L?H?5i$$ n"h 3|$"h "J.g n1|` n1| n1|1n0.H/HzRNJg* nHhHn HmHz NHn N`0.H/HzNJg* nHhHn/N-nt0.H ntC !n !nJ.g 1|` nt1| ntBh1n0.H/HzZNJg* ntHhHnpHmHz.NHnpN`0.H/Hz@NJg* ntHhHnpHmHzNHnpN`0.H/HzNJg* ntHhHnpHmHz HmHzNHn N`0.H/HzNJg* nHhHn HmHzNHn N`T0.H/HzxNJg* nHhHn HmHzFNHn N` nHhHmN/.N\( n8mN^.Nu PyP`8NHnpN`xpEnf* ntHhHnpHmHzNHnpN`FpFnf* ntHhHnpHmHzFNHnpN` ntHhHmN/.N\( nUm N^.Nu ` | NAB-BmvALNAHn/<&N-n nB!n "n!iHhHmN n1|1n $B n!nN^ _ NNA nHhHzpNd nHhHzNd nHhHzNd nHhHz Nd nHhHzNd nHhHzNd nHhHz@Nd nHhHzNCSbBB|B-B-lB-mB"B-B.| +|+| ACxSbACSb|!B-BBB|B-B-||B-|||B-B-B-|#Bm B-|+BmBm|&B-"B-(BmAfC:Sbd nHhHzNd nHhHzNd nHhHz Nd nHhHzNd nHhxHzTNd nHh|Hz~Nd nHhHzNd nHhHzNd nHhHzNd nHhHzNd nHhHzNd nHhHzNd nHhHzNd nHhHzNd nA:+H6ABCSbB-,B--B-)B-*;|B-BmB-$B-B- N^.NuFLTPTHDW SYSGLOBALSNAHmfHzNHmpHzNHmHzNHmzHnHnHzHmNHnHmpNHnNHmHzNHmHnHmHzpNHnNHmHz*NHhHzNd nHhHzNd nHhHzNd nHhHzNd nHhHzNd nHhHzNd nHhHzNdN^.NuLNPOSSTRSINCOSEXPGETPUTCOPYMARKSQRTINSERTDELETEESCAPEARCTANSTRRPTSTRPOSRELEASEMEMAVAILUNITBUSYHmHz"NHmHzPNN^.Nu`<=9@ \NA+|BR .SA 0".A! mN^.NuNA/N mB( |-|-r o<HmHn<A      n hHh/< N n h"h$hLH n h"hJf"h#h` n h"h" n h"hB!hN^.NuNA n h"h"iHQHn/< N n+hJ. g/N@ n h-hJ. g*"nHi/< N n"h2"hB nN^ _PONNAJ V nJWg\-n "h$i&n +" f!n nJg -h"nJ)f/)/.N n-h `N^ _PONNA nJV"h)AgB/. /NVJf?<N. n h|` n"hJf."h"i Jg?<N-h"n < -@JlBpnf/.0.H/N-_`/./.N-_ .䰮oHn .䐮/Np-n԰n-@pnf@p2.H-Aаn(-@ nR ."( C .Rh`NpnfDp-nаn4-@ nR "n. n h|`p-n n"h-i "h!Q"nJf$n/*/N6`6 n"hJ)g"n/)/.N n"h/)/.NN^ _PONNA n"h=i0.H/HzNJgpng nHh/<NJgb n"hHiC$mGESb<0? n"n ()g n "n0) h ]@` n hN^ _ NNA n h h"hHn?.?<N/-/Hz0?<?N/N`/N/NBm(Bm&BmBm*Bm;|FBBBHBLBPBTHmHznN/N߈/N N3l/Nt/N/Nb;|f N3l`?<N. n h|Hn n hHhHzPROGRAMAll rights reserved.Copyright Hewlett-Packard Company, 1982, 1991.NA n JfD+m, n hB(Hh/<N nHh"h/)/<N`J n  h"h"ipQf8 (̐R"h"i l?</N. n h|`@ n h (̐R"h"i2) Hl?</N. n h|`U n h"h /"h/) NhbJgR n h"h-i "npif.$h *]$h"*^g ?</N.` PLH=h$Hn/.N/. /<&NHn n //<&NN^ _PONNA nHh/. N6-m, nJgJPg?<2N. nB`d np,h fV"n#hJ-lgLH`4 n"hHQHn/< NHn/N n"h#nN^ _PONNA@U n h/( /("h/) NbJf?<N. n h| n h"h$hLH n h/(/NN^.Nu@NAJ V nJVgJ"h . g"?<N. n h|B ` n -h n"h!Q`J g?<N. n h|B     HQHz-IN"n m GOTOW8IFWLW*Wh IMPLEMENTW^W~1IMPORTWv/INWVXt(LABELWMODWWW&MODULEWW.NOTW%OFWWX0 O,`AC6pR@ f"S@fJ--g ?<eN.|-`tACpR@ f"S@fJ-)g ?<eN.|)`@ACpR@ f"S@fJ-*g ?<eN.|*` ?<hN.N3lpmVrmVgX^PROGRAMXV!RECORDXlWX,RECOVERXX9REPEATXSETXXX)THENXX TOXTRYXXY$8TYPE3l0-H/HmHzHmNHmNJgpmf N3l` ?<N.Bm(Bm&-,-g/-UGmVf&BNBGUGmVe*,f&.N>UGmVb*,f&.N(E TJg*,f`$d x_NMCN.HmHmHmHmNHmHzNHm?</-N`/-NBm(Bm&/-  !  >!- ! " "P P-M = = = =! =====! = =!= = = =*= = ==!==P$1P= M=!1P= M=!11nP1P=PP  - -"---6  1&:M1P=1PH1P=1P21P1P1PM=1P1- PbPP\PXP(*P0. P P      $ P P  P P  P P B} }P   - -"--- !2B"P        P      .   BP P<}P dB(LRFfr8H} }P dP<}P xlP!* !(P<>1P Z t " 6 r$8h!P  46^-*-          *,&PP  P PJ Y- ----  1 =1 1 != ==!= ==!= = ==1==1-1-BPBPBP@P,$D PBP"P PP>P0$!$&!$8 H P  ڈ( $     =1-=M=!1-1-!=-= -!-= -=-= -!-=1 -=1-=1-=1LB !  -=-  - - -  &   PP P PP0   l.    P 2 $   0     -M-=-  --1$ -=-Ո -  -1  -1-=-m- - -=1  $}}m-     .XN "  v     ,0 "ԈBPP PPPJPP(C      P P P  PPPPP PJP PP -P P4PPPPPPnP PP2PP P&P: PPPP&Q6!!PP"PPP8P"PP.P>&PPN؈ :- -P -2-PP!PP----P<P!PPP4PZPP P PP P8P0P2P2P0PPhP*PPPP* P4P,P&P@PPP&P,P@PPPPRP2PRPPPPPP.P2PPP>(PP PPPPPPP-PPPP,6P$ "PPPP PPPLPD PP.PXP4PNPPPTPPP PP PP P PP! P!P(PP*PPP!P(PBPPPPPPPPP -P Pj!P(PP!P(PBPPPPPPPPP -P"PP@X!P&PPP P P!P&PP B!P&PPT P PP* PPP&PP P(P-PFPPPPPPP(PP(PhPPPPP&P"PP,PPP(*P&P&PPPP P(P PP PpPP.P6 PP,PPPP,PPPP6P PPPPPP&P2PDP$PPP PPP"PP*PPPPP,P0PPPPPPPP(!PPPPP4PP4PPPPPPPPPP0PPPPPPPPP(}}Z}}@}}@}}@}}@}}@}}PTmY- - M- @M--&M-- $( 46M--M--TNM--4M--&!P&PPP\PP -P P PfP0P"(tt`}}$!,!HP P ! PPP^P2 PPT PP P(PPP2 PPPP"V}P P(PD0}P P P PPP PPP" PPP P P fPNP8PPP P ^ PPPP&P&* PP P (!(PPPPPPM--M--&P . M-"P *  " ( M-" }} P. ">  ":P220P  $M--Y- -P PP P P P2P P,PPPPPPP P&PP0-,0!(PPPPP PPP PP P P$P>PPJP PPP\PP4P P P PPPPPPBPFPPP(PP,P"4 PP PP,P PP PPP P^PXPPP2PPPP P&P,P P"P P$PPPP P(PPPPPP-1-=1YYY6" mYM- (*& R<11r    M- M-- M- M--PDPPPPPPPPPP2PPPPPPPPPP!PPPP PDF(!(PPPPP"PP P PP P PP"PP P(PPPPPJP4PPTP P P|PPPPPPPlPPP6PPPPP:Pn"PP(P(PP.PPP PHPPP P P`P2PP(P,PP2B 0 M-->P4.:$   M- M-- *P&   B$.2.2z M-- P  0P<PPP PPP.PPP`P P0P4P*P.PtP PPP.PPP"P.P">PPPbPPPQP(؈ j-P( .v<uD$-2 .TЎ.F>p"d2:-PPPP0PPP PPPPPPPP P$PPP*P0PPPXPPPPbP$PP.P!P&PPB!PPP.!P&PPPP P.PPPPPQLPvP *8P}P (4fP,PdP0 BP0tzm m6}@  PP PPPPPDP2 PP(PPPP*P0PP2PP&PPPPLPPPPPPlPnP4PnQ&P.P\P*P\PP&P*&"8:PPP8PD -PZPP!!P>P(zP$PP" PfP* V PPP P PPP8P0PPPP PPPPPlP2P PP"-PPPPP2PPPP*P6. P P PPPP|PP@PPPP !P*P.PP.PPPPPPP(PPJPP"PPPP^PPbP"PPPDPPZPP^PPZPD      P@P"!P(PP PPPPPPP PPPPP PT PPPPPPPPPP$PPFPVP.PpPP"PPPPfP4PPP8P P2PPPP8P P2PPPPQBPP*PnPPPPPPPPP.P"P(PP P"P PP PPP4P24P*PP:$P$PP PP LPP PPP  P! PPP PPPP!!1- P-: P2PPPPPJP8PPjP6P PP PJPP0P PP P PPPPP PPP,PP P"PHPВPXPȮ-P6P`P:PP- ----P^PPPPPPP(PPP>P P>P2PPDPHP.PPJPP(P,PP P2P@ &P(PP$PdP PPPZ~P0PP$P$PP$P`P0,PhRPjVHP|PPP*P * PPPP PP.PP$P PNP* P PPPPP,PPPPPPP -PZpPJPJP PPpPP P  P PP P>,}P P  !PPP PBPn  P1  m -YP -P -6 ! ! ! !P,}P}} -1-=M,PPP4PD$PHP"PPJP*PP>P"P"P"P PP8 P& PP*PP:P$P@PPPPP&P$PP PPPPP,P&PPPDPPPPHPPPhPfPPPP2PPPPPP(PP PP$PVP(PPP(P*P8P6P8P6PDPPPRPPP4P!PP,PP PPP>P(PRPP,PPP,PP PPP=- -= :} =-PP-:} =-PP--1P  j -- -- --E!<!** !> .\ P@$PPHPP6"PPP:PD(PPP P(P2PP2PPPPP PX PPPPPPPP6PP PPPP PPP PRP  PPPPPPP (P>P&P P8PP PPP*PP PPPPPPPP PPP PPPPPPPPPP PPPbPPN}P f}P PP P PPPP PPP

P P RP   PP4PPPP(PPP 6P0P2PPP(P0 PPP.P P P$P PPF$PPFPP&  P P   PP   PP,}}P PPPPPPPPPPPЖ}P PP VPPPPP  PPPPPPP0P P PP2P$PPP0P PP PPPP( PPP,PPPPPPPPPPPPPP0(P !P<> PPP P&P PPPP -!"!PPPPPPP$PP(P6j!n14P P$$P* PP P4PPPPhPJ P P,PP:PP(P2P P PP P,PP(P*4P0PP2P P& 4- - ---P P !D - - 4---P , PPP( PP2- -&}}P ---P P8PdPPPPPPP@PPP P0LP FP P4P*!PPPPP.,!PPPPP P P PPP P&\ P PP$!PLPPP P }P}}P} PPP*PP PP PPP P"P P PPPP PPP&* "P P @*PP P $^P(P : P:P$P*- -:---P PR8FP"^r- -$A9$--P l PPPP2P P0\PP(0P ( - -< U  } ---- -PPPP PP P"P PPP P$PP PP PPP PPP,P8P.PLPPbP8P&PPBPP P P`P PP$PP P P  P Pd PP&(}P} P -PP\ , :P|&!>TP P* PPPBPPP PP(&P P Z!zV &,! !"PPP.!О>*>P P PP,P P(PP*ňP*PPP &  !PPPPP PPPP @PPPP RPP P PPPP\(ň PPPP,ňPPPPP4P P PPDPP$P PP P P & P.}P    P:P :P ! P P PP PPPP.P P !P PP PP PPP"! P$-P "P PP PP@P P !P ňPPP( PP P ňPPP(PPP.] PLP P PňP$ P ,P.PPPP2ňPPP6 P $PP PPPP PP P   PZ        PP Ȏ--1-M&PP PP ňP PP P P4 !P  &,PP P PP P PP$ PP P PPPPň  Pň P PPP ň ň6"P 8P &P 8P PP: & PP PP P!(<P(P PP&P(P ZP$P8P P <PňBP P"P2P`PPPHЬPP(NPPPNPPPP@P r&&&&u& P:ňP PP!!!!!!!!P2!!PR PP PP PP P PP PPhP(P P P &PP|P6P*!$P4N8PP  !@P!P(PPP PP P$PP P(PP P P !!!!!- - --$ P>2 PbPPPfP&8ňPP P V"ňP .0PPPPPPJPPnPP2PP$P$P&PP".P:PP"\PňzP Pň.Pň0N!\P P:Pň P:P"P"!PP&PP&P P"!2PPPPP!"PPPPP8P(P Pp PP n- -D---P ȶ- - ---P PLH! &P"!!, P PNPP PPPPPP PfPP "PP>PP$P!4P PPP$PP$PPPPPPPňPPP4FPPPnP4PP8P.8P PP&P4V*!(ň P PPň!. PPPH!. P" P,8ň  PP P 2P& P PP"P* PP00PPP&PP2PPPfPP"PP PP(NPLP"  P PP PPP~ PP !!P(PBPP PP PPPP*  6P PP ^!BP!P PP- - ---P P4PP!R$ň0P PPPP! P"(PP8 PP PP PP P4P  P$PPJP PňTPP&PP*PP"P4ň PPňPPň PPP ňPPňPP PQ PRPPPP P.P &PPPP4P 0N4@P"PPPD  P"mP0m0m.PP   P PP PP"(]&! 0PPPPPP.P !$P:P >P!4 PP@P P DP P PP *(P@}P 0E     XP4P6PP&!.!2P (P6PPP P|*~P PP$PPPP PP$*P P,PPP P6PP P" PPP"PPP "P0PP P -P&P(-PP PP tPPPPPPPPPPPPPPPPPPPPPPPPPPPPPP!!D! j    P `!&P@PPPPPPPPPPPPPPPPPPPPPPPPPPPP!@!!Z P}P b -- -- Ym- }P - }P D-&}P &Ym"M*}P P0}} }}P 8}}P (Ym-P  ,&.Ђ       P d    (ň   *PP YEP P  P P4&!&P P$P P*P !DP !P Z!P PP  P PPP PP ވ PP   P P  PP -b( ] q]] q]m] -===P!P!P!MM1-1-=1-==1-1PPPP   Z("ňP 2PP PP PP P"  PNP P4PPP PPP4P PP ::P PPP   *P X-^&P  PPP P D,P !- ! -1-= !P>-!6!P P*,>!Ў -6!X$!b!PPP(P<P6P(.PP&P"PPfP