home *** CD-ROM | disk | FTP | other *** search
- title 'Pandora: Program ANimator by Pete Maclean'
-
-
- ;NOTE: This source code is for Version 1.5a. However, there is
- ;a later version of executable available which is 2.3.
-
-
- ;;; include pandora.hdr
-
- ; Symbol definitions
-
- CR = 13 ; ASCII carriage return
- LF = 10 ; ASCII linefeed
- TAB = 9 ; ASCII Tab
-
- ; BIOS Keyboard Buffer definitions
-
- KBB_SEGADD = 40h ; segment address of buffer
- KBB_HEAD = 1Ah ; offset to head pointer
- KBB_TAIL = 1Ch ; offset to tail pointer
- KBB_START = 80h ; offset to start pointer
- KBB_END = 82h ; offset to end pointer
-
- ; Pandora States
-
- PS_INITIAL = 0 ; initial state - no target program loaded
- PS_LOADED = 1 ; target program loaded
- PS_RUNNING = 2 ; target program running
- PS_OBIT = 3 ; waiting for target program to die
- PS_QUIT = 4 ; QUIT pending when target program dies
-
- code segment para public 'code'
- assume cs:code, ds:code
- org 100h
- start: jmp main ; entry point
-
- ; Messages
-
- initmsg db 'Pandora 1.5a (c) 1990 Ziff Communications Co.',CR,LF
- db 'PC Magazine ',254,' Pete Maclean',CR,LF,'$'
-
- crlfz db CR,LF,0
-
- ; Definition for command-table entry
-
- COMMAND STRUC
- PC_KEY dw ? ; (offset) address of command key
- PC_PROC dw ? ; (offset) address of command processor
- PC_TYPE db ? ; coded command type
- COMMAND ENDS
-
- command_entry_size db SIZE COMMAND
-
- ; Command types
-
- PCT_REG = 0 ; regular command
- PCT_IF = 2 ; If command
- PCT_ELSE = 4 ; Else command
- PCT_FI = 6 ; EndIf command
-
- ; Command table
-
- command_table LABEL COMMAND
- COMMAND <k_Alt, c_Alt, PCT_REG>
- COMMAND <k_Break, c_Break, PCT_REG>
- COMMAND <k_CapsLock, c_CapsLock, PCT_REG>
- COMMAND <k_Ctrl, c_Ctrl, PCT_REG>
- COMMAND <k_Cursor, c_Cursor, PCT_REG>
- COMMAND <k_DOS, c_DOS, PCT_REG>
- COMMAND <k_Else, c_Else, PCT_ELSE>
- COMMAND <k_EndIf, c_EndIf, PCT_FI>
- COMMAND <k_Env, c_Env, PCT_REG>
- COMMAND <k_Flush, c_Flush, PCT_REG>
- COMMAND <k_GetKey, c_GetKey, PCT_REG>
- COMMAND <k_Go, c_Go, PCT_REG>
- COMMAND <k_IfAfter, c_IfAfter, PCT_IF>
- COMMAND <k_IfBefore, c_IfBefore, PCT_IF>
- COMMAND <k_IfKey, c_IfKey, PCT_IF>
- COMMAND <k_IfLoad, c_IfLoad, PCT_IF>
- COMMAND <k_IfScreen, c_IfScreen, PCT_IF>
- jump_command COMMAND <k_Jump, c_Jump, PCT_REG>
- COMMAND <k_Key, c_Key, PCT_REG>
- ;;; COMMAND <k_KeyFile, c_KeyFile, PCT_REG>
- label_command COMMAND <k_Label, c_Label, PCT_REG>
- COMMAND <k_LeftShift, c_LeftShift, PCT_REG>
- COMMAND <k_Load, c_Load, PCT_REG>
- COMMAND <k_Lock, c_Lock, PCT_REG>
- COMMAND <k_Mode, c_Mode, PCT_REG>
- COMMAND <k_Numlock, c_NumLock, PCT_REG>
- COMMAND <k_Pause, c_Pause, PCT_REG>
- COMMAND <k_PrintScreen, c_PrintScreen, PCT_REG>
- COMMAND <k_Output, c_Output, PCT_REG>
- COMMAND <k_Quit, c_Quit, PCT_REG>
- COMMAND <k_RightShift, c_RightShift, PCT_REG>
- COMMAND <k_Screen, c_Screen, PCT_REG>
- COMMAND <k_ScrollLock, c_ScrollLock, PCT_REG>
- setif_command COMMAND <k_SetIf, c_SetIf, PCT_REG>
- COMMAND <k_SetMemory, c_SetMemory, PCT_REG>
- COMMAND <k_Tone, c_Tone, PCT_REG>
- COMMAND <k_TypeRate, c_TypeRate, PCT_REG>
- COMMAND <k_Unlock, c_Unlock, PCT_REG>
- COMMAND <k_Video, c_Video, PCT_REG>
- COMMAND <k_WaitChild, c_WaitChild, PCT_REG>
- COMMAND <k_WaitCursor, c_WaitCursor, PCT_REG>
- COMMAND <k_WaitScreen, c_WaitScreen, PCT_REG>
- COMMAND <k_WaitUntil, c_WaitUntil, PCT_REG>
- COMMAND <k_Wipe, c_Wipe, PCT_REG>
-
- JUMP_INDEX = (jump_command - command_table) / SIZE COMMAND
- LABEL_INDEX = (label_command - command_table) / SIZE COMMAND
- SETIF_INDEX = (setif_command - command_table) / SIZE COMMAND
-
- ; Command keywords
-
- command_keys LABEL BYTE
- k_Alt db "Alt",0
- k_Break db "Break",0
- k_CapsLock db "CapsLock",0
- k_Ctrl db "Ctrl",0
- k_Cursor db "Cursor",0
- k_DOS db "DOS",0
- k_Else db "Else",0
- k_EndIf db "EndIf",0
- k_Env db "Env",0
- k_Flush db "Flush",0
- k_GetKey db "GetKey",0
- k_Go db "Go",0
- k_IfAfter db "IfAfter",0
- k_IfBefore db "IfBefore",0
- k_IfKey db "IfKey",0
- k_IfLoad db "IfLoad",0
- k_IfScreen db "IfScreen",0
- k_Jump db "Jump",0
- k_Key db "Key",0
- ;;;k_KeyFile db "KeyFile",0
- k_Label db "Label",0
- k_LeftShift db "LeftShift",0
- k_Load db "Load",0
- k_Lock db "Lock",0
- k_Mode db "Mode",0
- k_NumLock db "NumLock",0
- k_Pause db "Pause",0
- k_PrintScreen db "PrintScreen",0
- k_Output db "Output",0
- k_Quit db "Quit",0
- k_RightShift db "RightShift",0
- k_Screen db "Screen",0
- k_ScrollLock db "ScrollLock",0
- k_SetIf db " SetIf",0 ; cannot be written
- k_SetMemory db "SetMemory",0
- k_Tone db "Tone",0
- k_TypeRate db "TypeRate",0
- k_Unlock db "Unlock",0
- k_Video db "Video",0
- k_WaitChild db "WaitChild",0
- k_WaitCursor db "WaitCursor",0
- k_WaitScreen db "WaitScreen",0
- k_WaitUntil db "WaitUntil",0
- k_Wipe db "Wipe",0
- db 0 ; end of table marker
-
- ; Key table for "On"/"Off" arguments:
-
- on_off db 'OFF',0,'ON',0,0 ; Off is 0, On is 1
-
- ; Key table for arguments to the Env[ironment] command:
-
- env_args db 'OWN',0,'MASTER',0,0 ; Own is 0, Master is 1
-
- ; Dispatch table for preprocessing commands by type
-
- preprocessing_table LABEL WORD
- dw pp_regular, pp_If, pp_Else, pp_EndIf
-
- ; Extra dispatch table for conditional commands
-
- n_table dw n_Nop, n_If, c_Else, c_EndIf
-
- ; Miscellaneous stuff
-
- pan_extension db '.PAN',0 ; Standard extension for Pan scripts
- pan_sp dw 0 ; SP on transferring to a child program
- allocated_block dw 0 ; segment of an allocated block
- break_condition db 0 ; ? break on or off
- command_ptr dw script_buffer
- current_command dw 0 ; pointer to current command in script_buffer
- DOS_buffer db 128 DUP (0) ; for use by DOS command (see c_DOS)
- env_inherit db 0 ; ? environment that children will get
- ; default is Pandora's own
- file_handle dw ? ; handle for command file
- if_condition db 0 ; IF condition
- if_effect_level db 0 ; Level at which last If was TRUE
- if_nest_level db 0 ; IF condition level
- in_pan_flag db 0 ; set non-zero when in Pandora timer intercept
- init_video_mode db 0 ; initial video mode
- key_getter dw 0 ; function to load a key
- keyboard_feed db 0 ; set when Pandora needs exclusive access
- ; to the keyboard
- keyboard_state db 0 ; 0 => unlocked, 1 => locked
- keyfile_handle dw 0 ; handle for KeyFile file
- kbb_segment dw KBB_SEGADD ; memory segment of keyboard buffer
-
- line_count db 0 ; byte for char count in line_buffer
- line_buffer db 128 dup (?) ; buffer for reading text through
-
- pan_state db PS_INITIAL ; see list of PS_xxxx states above
- screen_columns db 0 ; number of columns displayed in current video mode
- recall_address dw 0 ; address to recall after timer expiry
- time_out dw 0 ; time_out counter (ticks)
- type_rate dw 0 ; simulation rate for typing
- va db 70h ; video attribute, default like DOS MDA
- video_mode db 0 ; current video mode
- video_segment dw 0 ; memory segment address of video buffer
-
- ; Saved BIOS-keyboard interrupt vector
-
- i_BIOS_kb LABEL dword
- x_bk_offset dw 0
- x_bk_segment dw 0
-
- ; Saved timer interrupt vector
-
- i_timer LABEL dword
- x_timer_offset dw 0
- x_timer_segment dw 0
-
- ; Saved keyboard interrupt vector
-
- i_keyboard LABEL dword
- x_key_offset dw 0
- x_key_segment dw 0
-
- ; Saved Ctrl-Break interrupt vector
-
- i_ctrl_break LABEL dwORD
- x_break_offset dw 0
- x_break_segment dw 0
-
- ; Stack pointer from intercept
-
- callers_sp dw 0
- callers_ss dw 0
-
- ; Last keypress obtained by a GetKey command
-
- keypress LABEL WORD
- key_ASCII db 0
- key_scan db 0
-
- ; Screen position
-
- screen_position LABEL word
- n_col db 0 ; column number
- n_row db 0 ; row number
-
- ; "Keyboard" Input Queue pointers
-
- kiq_first dw 0 ; pointer to first/next character
-
- ; Hour and minute for WaitUntil command
-
- time_argument LABEL WORD
- minute db 0 ; minute to wait for (0 - 60)
- hour db 0 ; hour to wait for (0 - 24)
-
- ; Parameter block for DOS program-load function
-
- parameter_block LABEL WORD
- env_seg dw 0 ; segment of environment string
- p_command_line LABEL DWORD ; pointer to command line
- command_offset dw 0
- command_segment dw 0
- FCB1 LABEL dwORD ; FCB pointers
- FCB1_O dw 0
- FCB1_S dw 0
- FCB2 LABEL dwORD
- FCB2_O dw 0
- FCB2_S dw 0
- child_sp dw 0 ; child's SP
- child_ss dw 0 ; child's SS
- child_ip dw 0 ; child's IP
- child_cs dw 0 ; child's CS
-
- ; Other information about the child process
-
- child_psp dw 0 ; segment of child's PSP
- child_size dw 0 ; size in paragraphs
-
- ; Video mode table
-
- vseg_table LABEL BYTE ; Mode Type
- db 0B8h ; 0: CGA 40x25 b/w
- db 0B8h ; 1: CGA 40x25 16 colors
- db 0B8h ; 2: CGA 80x25 b/w
- db 0B8h ; 3: CGA 80x25 16 colors
- db 0 ; 4: CGA graphics mode
- db 0 ; 5: CGA graphics mode
- db 0 ; 6: CGA graphics mode
- db 0B0h ; 7: MDA 80x25 b/w
-
- ; Translation table: ASCII codes into keyboard scan codes
-
- scan db 03, 30, 48, 46, 32, 18, 33, 34, 35, 23, 36, 37, 38, 50, 49, 24
- ; Nul ^A ^B ^C ^D ^E ^F ^G ^H ^I ^J ^K ^L ^M ^N ^O
- db 25, 16, 19, 31, 20, 22, 47, 17, 45, 21, 44, 01, 26, 53, 27, 12
- ; ^P ^Q ^R ^S ^T ^U ^V ^W ^X ^Y ^Z Esc FS GS RS US
- db 57, 02, 40, 04, 05, 06, 08, 40, 10, 11, 09, 13, 51, 12, 52, 53
- ; sp ! " # $ % & ' ( ) * + , - . /
- db 11, 02, 03, 04, 05, 06, 07, 08, 09, 10, 39, 39, 51, 13, 52, 53
- ; 0 1 2 3 4 5 6 7 8 9 : ; < = > ?
- db 03, 30, 48, 46, 32, 18, 33, 34, 35, 23, 36, 37, 38, 50, 49, 24
- ; @ A B C D E F G H I J K L M N O
- db 25, 16, 19, 31, 20, 22, 47, 17, 45, 21, 44, 26, 43, 27, 07, 12
- ; P Q R S T U V W X Y Z [ \ ] ^ _
- db 41, 30, 48, 46, 32, 18, 33, 34, 35, 23, 36, 37, 38, 50, 49, 24
- ; ` a b c d e f g h i j k l m n o
- db 25, 16, 19, 31, 20, 22, 47, 17, 45, 21, 44, 26, 43, 27, 41, 14
- ; p q r s t u v w x y z { | } ~ Del
-
- ; Translation table for special keys
-
- keyname_list LABEL BYTE
- db 'ESC',0,'TAB',0,'ENTER',0
- db 'F10',0
- db 'F1',0,'F2',0,'F3',0,'F4',0,'F5',0,'F6',0,'F7',0,'F8',0,'F9',0
- db 'HOME',0,'UP',0,'PGUP',0,'LEFT',0
- db 'RIGHT',0,'END',0,'DOWN',0,'PGDN',0,'INS',0,'DEL',0
- db 0
-
- shiftname_list LABEL BYTE
- db 'ALT',0,'CTRL',0,'SHIFT',0,0
-
- shiftbits LABEL BYTE
- db 08h, 04h, 02h
-
- key_scans LABEL BYTE
- db 1 ; Escape
- db 15 ; Tab
- db 28 ; Enter
- db 68 ; F10
- db 59,60,61,62,63,64,65,66,67 ; F1 - F9
- db 71 ; Home
- db 72 ; Up Arrow
- db 73 ; Page Up
- db 75 ; Left Arrow
- db 77 ; Right Arrow
- db 79 ; End
- db 80 ; Down Arrow
- db 81 ; Page Down
- db 82 ; Insert
- db 83 ; Delete
-
- ; Shift tables
-
- No_shift LABEL WORD
- dw 0000h, 011Bh, 0231h, 0332h, 0433h, 0534h, 0635h, 0736h
- dw 0837h, 0938h, 0A39h, 0B30h, 0C2Dh, 0D3Dh, 0E08h, 0F09h
- dw 1071h, 1177h, 1265h, 1372h, 1474h, 1579h, 1675h, 1769h
- dw 186Fh, 1970h, 1A5Bh, 1B5Dh, 1C0Dh, 0000h, 1E61h, 1F73h
- dw 2064h, 2166h, 2267h, 2368h, 246Ah, 256Bh, 266Ch, 273Bh
- dw 2827h, 2960h, 0000h, 2B5Ch, 2C7Ah, 2D78h, 2E63h, 2F76h
- dw 3062h, 316Eh, 326Dh, 332Ch, 342Eh, 352Fh, 0000h, 372Ah
- dw 0000h, 3920h, 0000h, 3B00h, 3C00h, 3D00h, 3E00h, 3F00h
- dw 4000h, 4100h, 4200h, 4300h, 4400h, 0000h, 0000h, 4700h
- dw 4800h, 4900h, 4A2Dh, 4B00h, 0000h, 4D00h, 4E2Bh, 4F00h
- dw 5000h, 5100h, 5200h, 5300h
-
- Shift_shift LABEL WORD
- dw 0000h, 011Bh, 0221h, 0340h, 0423h, 0524h, 0625h, 075Eh
- dw 0826h, 092Ah, 0A28h, 0B29h, 0C5Fh, 0D2Bh, 0E08h, 0F00h
- dw 1051h, 1157h, 1245h, 1352h, 1454h, 1559h, 1655h, 1749h
- dw 184Fh, 1950h, 1A7Bh, 1B7Dh, 1C0Dh, 0000h, 1E41h, 1F53h
- dw 2044h, 2146h, 2247h, 2348h, 244Ah, 254Bh, 264Ch, 273Ah
- dw 2822h, 297Eh, 0000h, 2B7Ch, 2C5Ah, 2D58h, 2E43h, 2F56h
- dw 3042h, 314Eh, 324Dh, 333Ch, 343Eh, 353Fh, 0000h, 0000h
- dw 0000h, 3920h, 0000h, 5400h, 5500h, 5600h, 5700h, 5800h
- dw 5900h, 5A00h, 5B00h, 5C00h, 5D00h, 0000h, 0000h, 4737h
- dw 4838h, 4939h, 4A2Dh, 4B34h, 4C35h, 4D36h, 4E2Bh, 4F31h
- dw 5032h, 5133h, 5230h, 532Eh
-
- Ctrl_shift LABEL WORD
- dw 0000h, 011Bh, 0000h, 0300h, 0000h, 0000h, 0000h, 071Eh
- dw 0000h, 0000h, 0000h, 0000h, 0C1Fh, 0000h, 0E7Fh, 0000h
- dw 1011h, 1117h, 1205h, 1312h, 1414h, 1519h, 1615h, 1709h
- dw 180Fh, 1910h, 1A1Bh, 1B1Dh, 1C0Ah, 0000h, 1E01h, 1F13h
- dw 2004h, 2106h, 2207h, 2308h, 240Ah, 250Bh, 260Ch, 0000h
- dw 0000h, 0000h, 0000h, 2B1Ch, 2C1Ah, 2D18h, 2E03h, 2F16h
- dw 3002h, 310Eh, 320Dh, 0000h, 0000h, 0000h, 0000h, 3710h
- dw 0000h, 3920h, 0000h, 5E00h, 5F00h, 6000h, 6100h, 6200h
- dw 6300h, 6400h, 6500h, 6600h, 6700h, 0000h, 0000h, 7700h
- dw 0000h, 8400h, 0000h, 7300h, 0000h, 7400h, 0000h, 7500h
- dw 0000h, 7600h, 0000h, 0000h
-
- Alt_shift LABEL WORD
- dw 0000h, 0000h, 7800h, 7900h, 7A00h, 7B00h, 7C00h, 7D00h
- dw 7E00h, 7F00h, 8000h, 8100h, 8200h, 8300h, 0000h, 0000h
- dw 1000h, 1100h, 1200h, 1300h, 1400h, 1500h, 1600h, 1700h
- dw 1800h, 1900h, 0000h, 0000h, 0000h, 0000h, 1E00h, 1F00h
- dw 2000h, 2100h, 2200h, 2300h, 2400h, 2500h, 2600h, 0000h
- dw 0000h, 0000h, 0000h, 0000h, 2C00h, 2D00h, 2E00h, 2F00h
- dw 3000h, 3100h, 3200h, 0000h, 0000h, 0000h, 0000h, 0000h
- dw 0000h, 3920h, 0000h, 6800h, 6900h, 6A00h, 6B00h, 6C00h
- dw 6D00h, 6E00h, 6F00h, 7000h, 7100h, 0000h, 0000h, 0000h
- dw 0000h, 0000h, 0000h, 0000h, 0000h, 0000h, 0000h, 0000h
- dw 0000h, 0000h, 0000h, 0000h
-
- ;******************************************************************************
- ;* *
- ;* Interrupt-Intercept Procedures *
- ;* *
- ;******************************************************************************
-
- ; timer-interrupt intercept
-
- timer_intercept proc far
- pushf ; simulate another interrupt
- call cs:i_timer ; to let timer do its thing
- push ax
- mov al,1
- xchg al,cs:in_pan_flag ; check we're not already here
- or al,al
- jnz .tim4 ; exit immediately if so
-
- mov ax,sp ; switch stacks
- mov cs:callers_sp,sp
- mov ax,ss
- mov cs:callers_ss,ax
- mov ax,cs
- mov ss,ax
- mov sp,OFFSET interrupt_stack
- sti ; allow interrupts
-
- push bx ; save all registers
- push cx
- push dx
- push si
-
- push di
- push ds
- push es
- push bp
- mov ax,cs ; set DS and ES to Pandora segment
- mov ds,ax
- mov es,ax
- cld
-
- mov ax,time_out ; AX = number of ticks to timeout
- test ax,ax ; are we in a waiting period?
- jz .tim2 ; if no waiting
- dec time_out ; else count down the ticks
- jnz .tim3 ; if more to go
-
- .tim2: call timer_call
-
- .tim3: pop bp ; restore state
- pop es
- pop ds
- pop di
- pop si
- pop dx
- pop cx
- pop bx
-
- cli ; turn off interrupts
- mov ax,cs:callers_sp ; restore the interruptee's stack
- mov sp,ax
- mov ax,cs:callers_ss
- mov ss,ax
- mov cs:in_pan_flag,0 ; and reset in-Pandora flag
-
- .tim4: pop ax
- iret
- timer_intercept endp
-
- ; Called every time the timer interrupt is intercepted.
-
- timer_call proc near
- mov ax,recall_address
- test ax,ax ; need to do a recall?
- jz .tc1 ; no
- call ax ; yes, do it
- ret
-
- .tc1: call interpret ; process a new command
- cmp time_out,0 ; check number of ticks to timeout
- je .tc1 ; if no wait then do another
- ret
- timer_call endp
-
- ; Keyboard interrupt intercept. Every time a keyboard interrupt
- ; occurs we mess with the pointers to make it seem that the BIOS
- ; keyboard-input queue is full. This allows a Ctrl-Alt-Del to
- ; take effect but for all normal keypresses the user will get a
- ; beep.
-
- keyboard_intercept proc far
- push ax
- push ds
- mov ds,cs:kbb_segment ; DS = keyboard-buffer segment
- mov ax,ds:[KBB_TAIL] ; get tail
- inc ax ; bump tail pointer
- inc ax
- cmp ax,ds:[KBB_END]
- jne .ki1
- mov ax,ds:[KBB_START] ; if wrapped around
-
- .ki1: xchg ax,ds:[KBB_HEAD] ; make it look like there's no room
- pushf ; fake interrupt to real handler
- call cs:i_keyboard
- xchg ax,ds:[KBB_HEAD] ; replace "real" head of queue
- pop ds
- pop ax
- iret ; disconnects the keyboard
- keyboard_intercept endp
-
- ; BIOS-keyboard interrupt intercept
-
- BIOS_kb_intercept proc far
- pushf
- cmp ah,01h ; Function 0 or 1?
- ja .kbi2 ; no, let BIOS handle it
- sti ; ensure interrupts can happen
- je .kbi1
-
- ; Handle function 00h: Read Character from Keyboard. If Pandora has locked the
- ; keyboard then we delay the process until the lock is released. If Pandora has
- ; not locked the keyboard then we check if a character is available; if it is
- ; then we let the BIOS complete the request, else keep waiting in case Pandora
- ; locks the keyboard.
-
- .kbi0: test cs:keyboard_feed,0FFh ; has Pandora reserved the keyboard?
- jnz .kbi0
-
- mov ah,01h ; BIOS Get Keyboard Status
- pushf
- call cs:[i_BIOS_kb]
- jz .kbi0
- mov ah,00h
- jmp SHORT .kbi2
-
- ; Handle function 01h: Get Keyboard Status. If Pandora has locked the keyboard
- ; then we return a no-character-waiting indication to the process. If Pandora
- ; has not locked the keyboard then we let the BIOS handle the request.
-
- .kbi1: test cs:keyboard_feed,0FFh ; has Pandora reserved the keyboard?
- jz .kbi2 ; no, go to BIOS
- popf
- xor ax,ax ; yes, return with no input indication
- retf 2
-
- .kbi2: popf
- jmp cs:[i_BIOS_kb]
- BIOS_kb_intercept endp
-
- ; Ctrl-Break intercept
-
- ctrl_break_intercept proc far
- iret
- ctrl_break_intercept endp
-
- ;******************************************************************************
- ;* *
- ;* Entry Code *
- ;* *
- ;******************************************************************************
-
- assume ds:code
- main proc near
- cld
- mov sp,OFFSET regular_stack ; set internal stack
-
- mov dx,OFFSET initmsg ; announce program
- mov ah,9h
- int 21h
- call c_Mode ; determine video mode
- mov al,video_mode ; save initial video mode
- mov init_video_mode,al
- push es
- mov ax,3516h ; get interrupt vector for BIOS kb
- int 21h ; ES:BX -> BIOS kb service
- mov x_bk_offset,bx ; save this for internal use
- mov ax,es
- mov x_bk_segment,ax
- pop es
-
- call get_script ; load the command file
- jc .mai3
- mov bx,OFFSET script_buffer ; calculate paragraphs used
- add bx,ax ; AX = size of script as loaded
- add bx,15 ; round up to a paragraph boundary
- mov cx,4
- shr bx,cl ; convert to paragraphs
- mov ah,4Ah ; DOS modify allocated memory blocks
- int 21h
- call resolve_jumps ; prepare the script
- jc .mai3 ; if an error was detected
- mov ax,OFFSET script_buffer ; set command pointer
- mov command_ptr,ax
-
- .mai1: call interpret ; perform the first/next command
-
- .mai2: xor cx,cx
- xchg cx,time_out ; CX = timeout
- test cx,cx ; did last command set a timeout?
- jz .mai1 ; if not continue processing
- call delay ; else delay for the requisite period
- call [recall_address] ; then call the completion code
- jmp SHORT .mai2 ; which can timeout again
-
- .mai3: mov ah,9h ; get here with SI -> error message
- int 21h ; have DOS display it
-
- .mai4: jmp terminate ; die
- main endp
-
- ;******************************************************************************
- ;* *
- ;* Primary Pandora Command Interpreter *
- ;* *
- ;******************************************************************************
-
- interpret proc near
- mov si,command_ptr ; SI -> next command
- xor ax,ax
- lodsb ; AX = command length
- test al,al ; zero-length command => end of script
- jz .int3
- add command_ptr,ax ; update the command pointer
- mov current_command,si ; save pointer to current command
- lodsb ; AX = command index
- mul command_entry_size ; convert to table offset
- mov bx,ax ; BX = entry offset
- xor ax,ax
- or al,if_condition
- jnz .int1 ; if processing off
- ; call the command processor with AX = 0
- call WORD PTR [command_table+PC_PROC+bx]
- ret
-
- .int1: xor ax,ax ; get AX = command type
- mov al,BYTE PTR [command_table+PC_TYPE+bx]
- mov bx,ax ; and call corresponding proc
- call [n_table+bx]
-
- .int2: ret
-
- .int3: jmp c_Quit ; Quit on end of script
- interpret endp
-
- ;******************************************************************************
- ;* *
- ;* Procedures for performing Pandora commands *
- ;* *
- ;******************************************************************************
-
- ; Alt ON/OFF
-
- c_Alt proc near
- mov dl,08h ; DL = Alt bit in keyboard flags
- jmp ShiftLock
- c_Alt endp
-
- ; Break On/Off
-
- c_Break proc near
- mov bx,OFFSET on_off ; BX -> "ON/OFF"
- call match_key ; check the argument
- jne .cb1 ; if not "ON" nor "OFF"
- mov break_condition,al ; else index sets the break condition
- ret
-
- .cb1: mov si,OFFSET .cbmsg
- jmp command_error
-
- .cbmsg db 'Break should have argument "On" or "Off"',0
- c_Break endp
-
- ; Else - if Else belongs to the last If processed then reverse the
- ; current if condition
-
- c_Else proc near
- mov al,if_nest_level ; is this else effective?
- cmp al,if_effect_level
- ja .cel1 ; ignore if not
- not if_condition ; switch the condition marker
-
- .cel1: ret
- c_Else endp
-
- ; CapsLock ON/OFF
-
- c_CapsLock proc near
- mov dl,40h ; DL = CapsLock bit in keyboard flags
- jmp ShiftLock
- c_CapsLock endp
-
- ; Ctrl ON/OFF
-
- c_Ctrl proc near
- mov dl,04h ; DL = Alt bit in keyboard flags
- jmp ShiftLock
- c_Ctrl endp
-
- ; Cursor <row> <column> - move the cursor to the given position.
-
- c_Cursor proc near
- call get_screen_position ; decode row and column
- mov ah,02h ; BIOS Set Cursor Position
- xor bx,bx ; assume page 0
- mov dx,screen_position ; DH = row, DL = column
- int 10h
- ret
- c_Cursor endp
-
- ; DOS "command" - execute a command via the DOS command interpreter.
- ;
-
- c_DOS proc near
- cmp pan_state,PS_RUNNING ; is state suitable for DOS call?
- jae .dos3 ; give error if it's not
- call normalize ; normalize the argument
- mov di,OFFSET DOS_buffer
- mov si,OFFSET DOS_options ; copy " /c "
- call copy_string
- mov si,OFFSET line_buffer ; and copy the user's command
- call copy_string
- mov WORD PTR es:[di],000Dh ; append a CR and null
- mov command_offset,OFFSET DOS_buffer
- mov command_segment,ds ; set up parameter block
- mov ax,cs:[2Ch] ; AX = environment segment
- mov env_seg,ax
- mov si,OFFSET comspec ; search env for "COMSPEC"
- call search_env ; returns DS:SI -> string if found
- mov dx,si ; DOS needs DS:DX -> program file
- jc .dos1 ; if not found
- mov ax,4B00h ; DOS Load and Execute a Program
- mov bx,OFFSET parameter_block
- int 21h
- push cs ; restore DS
- pop ds
- jc .dos2 ; if Exec failed
- ret
-
- .dos1: mov si,OFFSET .dosmsg1 ; complain about command interpreter
- jmp SHORT .dos4
-
- .dos2: mov si,OFFSET .dosmsg2
- cmp ax,8 ; insufficient memory?
- je .dos4
- mov si,OFFSET .dosmsg3 ; complain that Exec failed
- jmp SHORT .dos4
-
- .dos3: mov si,OFFSET .dosmsg4 ; complain about the state of things
-
- .dos4: jmp command_error
-
- .dosmsg1 db 'COMSPEC not found in environment',0
- .dosmsg2 db "Insufficient memory to load command interpreter",0
- .dosmsg3 db "Execution of command interpreter failed",0
- .dosmsg4 db "May not be used while running a program",0
- comspec db "COMSPEC",0
-
- DOS_options db " /c ",0
- c_DOS endp
-
- ; EndIf - terminate an IF clause
-
- c_EndIf proc near
- cmp if_nest_level,0 ; is EndIf appropriate?
- jz .cen1 ; ignore if not (should be impossible)
- mov al,if_nest_level ; if this EndIf effective?
- dec if_nest_level ; count out one level
- cmp al,if_effect_level
- jne .cen1 ; if not there is no more to do
- dec if_effect_level
- mov if_condition,0 ; process!
-
- .cen1: ret
- c_EndIf endp
-
- ; Env Master/Own
- ;
- ; Set environment to be inherited by children:
- ; "Own" means each child gets a copy of Pandora's environment.
- ; "Master" means each child get a copy of the master environment.
-
- c_Env proc near
- mov bx,OFFSET env_args ; BX -> "MASTER/OWN"
- call match_key ; check the argument
- jne .cenv1 ; if not valid
- mov env_inherit,al ; else index sets the condition
- ret
-
- .cenv1: mov si,OFFSET .cenvm
- jmp command_error
-
- .cenvm db 'Should have argument "Master" or "Own"',0
- c_Env endp
-
- ; Flush - flush keypress buffer
-
- c_Flush proc near
-
- .cf1: mov ah,01h ; check for keyboard input
- pushf ; by emulating interrupt to the BIOS
- call [i_BIOS_kb] ; int 16h
- jz .cf2 ; if no input
- xor ax,ax ; else read that input
- pushf
- call [i_BIOS_kb] ; int 16h
- jmp SHORT .cf1 ; keep checking until there is none
-
- .cf2: ret
- c_Flush endp
-
- ; GetKey - input a keypress
-
- c_GetKey proc near
- cmp pan_state,PS_RUNNING ; target program in action?
- je .gk3 ; yes, get a keypress by stealth
- mov ah,00h ; else just use BIOS service
- int 16h
- mov keypress,ax ; save the codes
- cmp break_condition,0 ; break mode on?
- jz .gk1 ; no, don't handle aborts specially
- cmp ax,2E03h ; Control-C?
- je .gk2 ; quit if so
-
- .gk1: ret
-
- .gk2: jmp c_Quit
-
- .gk3: inc time_out ; check on every tick
- mov recall_address,OFFSET .gk4 ; come back at label .gk4
- inc keyboard_feed ; lock the keyboard
- ret
-
- .gk4: mov ah,01h ; check for keyboard input
- pushf
- call [i_BIOS_kb] ; int 16h
- jz .gk5 ; if none
- xor ax,ax ; read that input
- pushf
- call [i_BIOS_kb] ; int 16h
- mov keypress,ax ; save it
- dec keyboard_feed ; release the keyboard
- mov recall_address,0 ; no more recall
- ret
-
- .gk5: inc time_out ; continue waiting
- ret
- c_GetKey endp
-
- ; Go - initiate execution of a loaded program
-
- c_Go proc near
- cmp pan_state,PS_LOADED ; check that state is correct
- je .go2 ; if okay...
- mov si,OFFSET .gomsg2 ; "Program already running"
- jg .go1 ; error if Go done already
- mov si,OFFSET .gomsg1 ; "No program loaded"
-
- .go1: jmp command_error
-
- .gomsg1 db 'No program loaded',0
- .gomsg2 db 'Program already running',0
-
- ; Copy command line to child's PSP
-
- .go2: call normalize ; copy command line
- mov es,child_psp ; ES = PSP of child
- mov di,81h ; ES:DI -> command-line area
- mov al,' ' ; force a blank at the start
- cmp [si],al
- je .go3
- stosb ; good command lines start this way
-
- .go3: rep movsb ; copy command line
- mov BYTE PTR es:[di],CR ; and append a carriage return
- mov ax,di ; calculate length of command line
- sub al,81h
- mov es:[80h],al ; and prepend length to the line
-
- ; Set up default FCBs just in case
-
- push ds
- mov ax,2901h ; DOS Parse filename
- mov ds,child_psp
- mov si,81h ; DS:SI -> command line to parse
- mov di,92 ; ES:DI -> place for 1st FCB
- int 21h
- mov cx,ax ; save drive valid flag
- mov ax,2901h ; DOS Parse filename
- mov di,108 ; ES:DI -> place for 2nd FCB
- int 21h
- pop ds
-
- mov in_pan_flag,1 ; make intercepts ineffective
- call set_traps ; set traps
- mov pan_state,PS_RUNNING ; set state to running
- jmp run_it ; and transfer control
- c_Go endp
-
- ; IfAfter "HH:MM" - check if past given time of day
-
- c_IfAfter proc near
- call decode_time
- mov ah,2Ch ; DOS Get Time
- int 21h
- cmp cx,time_argument ; is it after the given time?
- jae iftrue
- jb iffalse
- c_IfAfter endp
-
- ; IfBefore "HH:MM" - check if past given time of day
-
- c_IfBefore proc near
- call decode_time
- mov ah,2Ch ; DOS Get Time
- int 21h
- cmp cx,time_argument ; is it before the given time?
- jb iftrue
- jae iffalse
- c_IfBefore endp
-
- ; IfKey "keylist" - check if last captured keystroke is in the given list.
-
- c_IfKey proc near
- call normalize ; copy and fix the string
-
- .ifk1: call translate_key ; get AX = key code
- jc iffalse ; if no more keys in string
- cmp ax,keypress ; is it what we captured?
- je iftrue
- jne .ifk1
- c_IfKey endp
-
- ; IfLoad "program_name" - attempt to load the specified program and
- ; set condition code according to result
-
- c_IfLoad proc near
- cmp pan_state,PS_INITIAL ; check that state is suitable
- jne .ifl1 ; if a program has already been loaded
- call loader ; try the load
- jc iffalse ; if load failed
- jnc iftrue
-
- .ifl1: mov si,OFFSET .loadm ; complain, complain, complain
- jmp command_error
-
- .loadm db 'A program is already loaded',0
- c_IfLoad endp
-
- ; IfScreen <row> <column> "string" - check if "string" appears on screen
-
- c_IfScreen proc near
- call get_screen_position ; decode row and column
- call skip_whitespace ; find the "string"
- call normalize ; copy and normalize the string
- call check_screen ; check if it's there
- jnc iftrue ; if the string is there
- jc iffalse ; if it's not
- c_IfScreen endp
-
- ; Set If condition false
-
- iffalse proc near
- not if_condition ; inhibit processing
- ; and fall through
- iffalse endp
-
- ; Set If condition true
-
- iftrue proc near
- inc if_nest_level ; count up one more If level
- inc if_effect_level ; and active level
- ret
- iftrue endp
-
- ; Jump label - transfer control to command following the named label.
-
- c_Jump proc near
- lodsw ; AX -> destination
- mov command_ptr,ax ; set new command pointer
- ret
- c_Jump endp
-
- ; Key "string" - make it appear as though "string" were typed.
-
- c_Key proc near
- call copy_quoted_string ; copy the string
- mov kiq_first,si ; point to first character
- mov ax,OFFSET get_kiq ; set proc to call for a keycode
- mov key_getter,ax
- inc time_out ; continue on next tick
- mov recall_address,OFFSET stuff_keys ; at proc stuff_keys
- ret
- c_Key endp
-
- ; KeyFile "filename" - move contents of file to keyboard buffer
- ;
- ; Called with:
- ; SI -> name of file
-
- c_KeyFile proc near
- cmp pan_state,PS_RUNNING ; check that state is correct
- jae .kf1 ; if state unsuitable
- call normalize ; normalize the filename
- mov ax,3D00h ; DOS Open File
- mov dx,si ; DX -> filename
- int 21h
- jc .kf2
- mov keyfile_handle,ax ; save the file handle
- mov ax,OFFSET get_keyfile ; set proc to call for a keycode
- mov key_getter,ax
- inc time_out ; continue on next tick
- mov recall_address,OFFSET stuff_keys ; at proc stuff_keys
- ret
-
- .kf1: mov si,OFFSET .kfmsg1
- jmp command_error
-
- .kf2: mov si,OFFSET .kfmsg2
- jmp command_error
-
- .kfmsg1 db "KeyFile may not be used while running a program",0
- .kfmsg2 db "Error opening KeyFile file",0
- c_KeyFile endp
-
- ; Label name
-
- c_Label proc near
- ret ; no operation
- c_Label endp
-
- ; LeftShift ON/OFF
-
- c_LeftShift proc near
- mov dl,02h ; DL = Left-Shift bit in keyboard flags
- jmp ShiftLock
- c_LeftShift endp
-
- ; Load "program_name"
- ;
- ; Note: During the load process, Pandora switches environment-table pointers so
- ; that the loaded program inherits a copy of the master environment rather than
- ; Pandora's own. This trick allows DOS SET commands to be used in Pandora scripts to
- ; set environment strings for automated programs.
-
- c_Load proc near
- cmp pan_state,PS_INITIAL ; check that state is suitable
- jne .cl2 ; if a program has already been loaded
- call loader ; attempt a load
- jc bad_load ; if load failed
-
- .cl1: ret ; load successful, continue
-
- .cl2: jmp .ifl1
- bad_load:
- mov dx,OFFSET .clA ; "Cannot find target program"
- cmp al,3 ; file or path not found?
- jle .bl1
- mov dx,OFFSET .clB ; "Insufficient memory to load"
- cmp al,8
- je .bl1
- mov dx,OFFSET .clC ; "Cannot load target program"
-
- .bl1: mov ah,9h
- int 21h
- call ttyz ; display filename
- jmp c_Quit
-
- .clA db 'Pandora Error: Cannot find target program: $'
- .clB db 'Pandora Error: Insufficient memory to load program: $'
- .clC db 'Pandora Error: Cannot load target program: $'
- c_Load endp
-
- ; Lock - disconnect keyboard from application
-
- c_Lock proc near
- cmp keyboard_state,0 ; is keyboard already locked?
- jne .loc1 ; if so this is a no-op
- inc keyboard_state ; else set state to locked
- mov dx,OFFSET keyboard_intercept ; replace keyboard interrupt
- mov al,9h
- mov bx,OFFSET i_keyboard
- call set_vector
-
- mov dx,OFFSET ctrl_break_intercept ; replace Ctrl-Break interrupt
- mov al,23h
- mov bx,OFFSET i_ctrl_break
- call set_vector
-
- .loc1: ret
- c_Lock endp
-
- ; Mode - force reassessment of current video mode
-
- c_Mode proc near
- mov ah,0Fh ; BIOS Get Video Mode
- int 10h ; returns AH = # columns, AL = mode,
- ; and BH = active page
- mov video_mode,al ; save the mode
- cmp al,7 ; we only do text modes (0,1,2,3 and 7)
- ja .cm1
- mov screen_columns,ah ; save number of columns on screen
- xor ah,ah
- mov bx,ax ; BX = mode
- xor ax,ax
- mov ah,[vseg_table+bx] ; AX = video buffer segment
- mov video_segment,ax
- ret
-
- ; Video mode that Pandora does not handle
-
- .cm1: mov si,OFFSET .cmmsg
- jmp command_error
-
- .cmmsg db "Application set a video mode that Pandora cannot handle",0
- c_Mode endp
-
- ; NumLock ON/OFF
-
- c_NumLock proc near
- mov dl,20h ; DL = NumLock bit in keyboard flags
- jmp ShiftLock
- c_NumLock endp
-
- ; Output <string> - send a string to standard output
-
- c_Output proc near
- cmp pan_state,PS_RUNNING ; is state suitable for DOS call?
- jae .co2 ; ignore the command if it's not
- call normalize ; straighten up the string
-
- .co1: lodsb ; AL = next character
- test al,al
- jz .co2 ; at end of string
- mov ah,02h ; DOS Display Output
- mov dl,al ; DL = character
- int 21h
- jmp SHORT .co1 ; loop for all characters
-
- .co2: ret
- c_Output endp
-
- ; Pause <n> ticks/seconds/minutes - delay for a given period
-
- c_Pause proc near
- call decode_duration
- jc .cp2
- mov time_out,ax ; set waiting time
- mov recall_address,OFFSET .cp1 ; and set recall
- ret
-
- .cp1: mov recall_address,0
- ret
-
- .cp2: mov si,OFFSET .cpmsg ; 'Pause 1-255 ticks, 1-255 seconds or 1-60 minutes'
- jmp command_error
-
- .cpmsg db 'Pause 1-255 ticks, 1-255 seconds or 1-60 minutes',0
- c_Pause endp
-
- ; PrintScreen
-
- c_PrintScreen proc near
- int 5 ; this is the trick
- ret
- c_PrintScreen endp
-
- ; Quit
-
- c_Quit proc near
- call unset_traps ; make sure no traps are left set
- call c_Unlock ; and that the keyboard is unlocked
- cmp pan_state,PS_LOADED ; got a program loaded and ready to go?
- je .cq2 ; if so we must get rid of it
- cmp pan_state,PS_RUNNING ; running a child program?
- je .cq1 ; if so
- jmp terminate ; otherwise we can exit gracefully
-
- .cq1: mov pan_state,PS_QUIT ; quit when target program quits
- mov ax,1
- ret
-
- .cq2: mov child_cs,cs ; fix things so child will die at birth
- mov ax,OFFSET terminate
- mov child_ip,ax
- mov pan_state,PS_QUIT ; quit when target program quits
- jmp run_it ; then go run it
- c_Quit endp
-
- ; RightShift ON/OFF
-
- c_RightShift proc near
- mov dl,01h ; DL = Right-Shift bit in keyboard flags
- jmp ShiftLock
- c_RightShift endp
-
- ; Screen <row> <column> "string" - write a string directly onto the
- ; screen.
-
- c_Screen proc near
- call get_screen_position ; decode row and column
- call skip_whitespace ; skip to "string"
- call normalize ; copy and fix the string
- mov dx,screen_position ; DX = row + column
- mov bl,va ; BL = video attribute
- call display_string ; display the string
- ret
- c_Screen endp
-
- ; ScrollLock ON/OFF
-
- c_ScrollLock proc near
- mov dl,10h ; DL = Scroll Lock bit in keyboard flags
- jmp ShiftLock
- c_ScrollLock endp
-
- ; SetIf - set the if nesting level after a Label.
- ;
- ; Note: This is an internal command that is inserted automatically
- ; following each Label command. The effect is to make Ifs and
- ; EndIfs work like proper bracket operators. It allows Jumps
- ; to be made out of If/EndIf blocks. It also, er, allows Jumps
- ; to be made into If/EndIf blocks!!
-
- c_SetIf proc near
- lodsb ; AL = current level
- mov if_nest_level,al ; make that the nesting level
- mov if_effect_level,al ; and the effective level
- ret
- c_SetIf endp
-
- ; SetMemory <n> - sets the largest block of free memory to <n>KB
-
- c_SetMemory proc near
- cmp pan_state,PS_INITIAL ; only useable in initial state
- jne .sm7
- xor ax,ax
- xchg ax,allocated_block ; release any previous allocation
- test ax,ax
- jz .sm1 ; if none
- push es
- mov es,ax
- mov ah,49h
- int 21h ; assume success
- pop es
-
- .sm1: call decode_decimal ; get AX = decimal KB parameter
- mov cl,6 ; convert to paragraphs
- shl ax,cl
- push ax
- mov ah,48h ; determine size of largest free
- mov bx,-1 ; memory block
- int 21h
- jnc .sm8 ; should fail, begorrah!
- pop ax
- sub bx,ax ; is there enough memory?
- js .sm9 ; no
- mov ah,48h ; allocate the difference
- int 21h
- jc .sm8 ; should not fail!
- mov allocated_block,ax
- ret
-
- .sm7: mov si,OFFSET .smm1 ; complain, complain, complain
- jmp command_error
-
- .sm8: mov si,OFFSET .smm2 ; bitch, bitch, bitch
- jmp command_error
-
- .sm9: mov si,OFFSET .smm3 ; moan, moan, moan
- jmp command_error
-
- .smm1 db 'May be used only before a program is loaded',0
- .smm2 db 'Memory allocation error',0
- .smm3 db 'Insufficient memory available',0
- c_SetMemory endp
-
- ; Tone <frequency> <duration> - sound a tone on the PC speaker
- ;
- ; Note: The following procedure is based on code originally developed
- ; by Joe Campbell. The original is Copyright 1985, 1986 by Joe
- ; Campbell, Box 7159, Berkeley, CA 94707.
-
- LOWEST_HZ EQU 50
- HIGHEST_HZ EQU 15000
-
- c_Tone proc near
- call decode_decimal ; get AX = frequency
- test ax,ax
- jz .ton1 ; 0 => cancel previous tone
- cmp ax,LOWEST_HZ ; check frequency okay
- jb .ton3
- cmp ax,HIGHEST_HZ
- ja .ton3
- mov di,ax ; DI = frequency
- mov al,0B6h ; set timer mode to oscillator
- out 43h,al
- mov dx,12h ; 1.193180 MHz = 1234DC hex
- mov ax,34DCh
- div di ; divide DX:AX by DI, result to AX
- out 42h,al ; write low byte of count
- xchg al,ah ; AL = high byte
- out 42h,al ; write high byte
- in al,61h ; get current speaker port setting
- mov .tonp,al ; save speaker-port setting
- or al,3 ; turn speaker on
- out 61h,al
- call skip_whitespace
- call decode_duration ; decode duration, get AX = ticks
- test ax,ax
- jz .ton2
- mov time_out,ax
- mov recall_address,OFFSET .ton1
- ret
-
- .ton1: mov recall_address,0 ; cancel recall
- mov al,.tonp ; otherwise, recover value of port
- and al,NOT 03h ; reset speaker-on bit
- out 61h,al
-
- .ton2: ret
-
- .ton3: mov si,OFFSET .tonm1
- jmp command_error
-
- .tonm1 db "Frequency outside valid range of 50 - 15,000 Hz",0
-
- .tonp db 0 ; saved setting of speaker port
- c_Tone endp
-
- ; TypeRate <ticks> - set a rate for emulating typing (in ticks)
-
- c_TypeRate proc near
- call decode_decimal ; decode decimal tick count
- mov type_rate,ax ; store the type rate
- ret
- c_TypeRate endp
-
- ; Unlock - connect keyboard to application
-
- c_Unlock proc near
- cmp keyboard_state,1 ; is keyboard locked?
- jne .unl1 ; if not this is a no-op
- dec keyboard_state ; set state to unlocked
- mov al,9h ; remove keyboard intercept
- mov bx,OFFSET i_keyboard
- call restore_vector
- mov al,23h ; reset Control-Break vector
- mov bx,OFFSET i_ctrl_break
- call restore_vector
-
- .unl1: ret
- c_Unlock endp
-
- ; Video <attribute> - set video attribute.
-
- c_Video proc near
- call decode_hex ; decode attribute into AL
- mov va,al ; and store it away
- ret
- c_Video endp
-
- ; WaitChild - wait for child to die.
-
- c_WaitChild proc near
- cmp pan_state,PS_RUNNING ; only valid in running state
- jne .wc3 ; error in any other state
- mov pan_state,PS_OBIT ; change state to PS_OBIT
- call unset_traps ; no longer need these
- inc time_out ; to stop command processing for now
- ret
-
- .wc3: mov si,OFFSET .wcA ; what is Pandora expected to do?
- jmp command_error
-
- .wcA db 'No program running to wait for',0
- c_WaitChild endp
-
- ; WaitCursor <row> <column> - wait for the cursor to be positioned
-
- c_WaitCursor proc near
- call get_screen_position ; decode row and column
- inc time_out ; check on next tick
- mov recall_address,OFFSET .wcu1 ; at label .wcu1
- ret
-
- .wcu1: mov ah,03h ; BIOS Get Cursor Position
- xor bx,bx ; page 0
- int 10h ; returns DH = row, DL = column
- cmp dx,screen_position
- je .wcu4 ; if the cursor is there
-
- .wcu3: mov time_out,3 ; try again in 3 more ticks' time
- ret
-
- .wcu4: mov recall_address,0
- ret
- c_WaitCursor endp
-
- ; WaitScreen <row> <column> "string" - wait for the given string to
- ; appear on screen.
-
- c_WaitScreen proc near
- call get_screen_position ; decode row and column
- call skip_whitespace ; skip to the "string"
- call normalize ; copy and normalize the string
- inc time_out ; check on next tick
- mov recall_address,OFFSET .ws1 ; at label .ws1
- ret
-
- .ws1: mov si,OFFSET line_buffer ; SI -> string to be matched
- call check_screen ; see if it's there
- jnc .ws4 ; if the string has appeared
-
- .ws3: mov time_out,3 ; try again in 3 more ticks' time
- ret
-
- .ws4: mov recall_address,0
- ret
- c_WaitScreen endp
-
- ; WaitUntil <HH:MM> - wait until a given time of day
-
- c_WaitUntil proc near
- cmp pan_state,PS_RUNNING ; cannot do this in background mode
- jae .wu5
- call decode_time ; decode "HH:MM"
- mov time_out,18 ; check every second
- mov recall_address,OFFSET .wu1 ; below
- ret
-
- .wu1: mov ah,2Ch ; DOS Get Time
- int 21h
- cmp cx,time_argument ; has the due time come around?
- jne .wu3 ; no, keep waiting
-
- .wu2: mov recall_address,0 ; yes, do next command
- ret
-
- .wu3: mov ah,01h ; check for keyboard input
- pushf
- call [i_BIOS_kb] ; int 16h
- jz .wu4 ; if none
- xor ax,ax ; read that input
- pushf
- call [i_BIOS_kb] ; int 16h
- cmp al,1Bh ; Escape?
- jne .wu4 ; ignore anything but
- cmp pan_state,PS_RUNNING ; running a program?
- je .wu2 ; yes, skip to next command
- jmp terminate ; no, terminate the program
-
- .wu4: mov time_out,18 ; wait another second
- ret
-
- .wu5: mov si,OFFSET .wuA ; "Command not valid during background operation"
- jmp command_error
-
- .wuA db 'Command not valid during background operation',0
- c_WaitUntil endp
-
- ; Wipe - clear the screen
-
- c_Wipe proc near
- mov ax,0600h ; BIOS Initialize Window
- mov bh,07h ; use "white on black" attribute
- xor cx,cx
- mov dl,screen_columns
- mov dh,44 ; assume largest text screen
- int 10h ; returns AL = display mode
- ret
- c_Wipe endp
-
- ; Procedures for handling commands while command-processing is inhibited.
-
- ; Process any kind of IF command when processing suspended
-
- n_If proc near
- inc if_nest_level ; one level of If/EndIf deeper
- ret
- n_If endp
-
- ; Regular commands are no-ops
-
- n_Nop proc near
- ret
- n_Nop endp
-
-
- ;******************************************************************************
- ;* *
- ;* Miscellaneous procedures *
- ;* *
- ;******************************************************************************
-
- ; check_screen - checks if a given string appears at a given screen position
- ;
- ; Called with:
- ; SI -> string to be sought
- ; 'screen_position' holding the row and column
- ;
- ; Returns:
- ; CF = 0 if string is found
- ; CF = 1 otherwise
-
- check_screen proc near
- push es
- mov dx,screen_position ; set Pandora screen position
- call set_video_address
-
- .chs1: cmp BYTE PTR [si],0 ; check the next byte
- je .chs3 ; if null we matched the whole string!
- mov ax,es:[di] ; AH = attribute, AL = character code
- cmp [si],al ; is character the one we want?
- jne .chs2 ; no, so match fails...
- inc di ; yes, check next
- inc di
- inc si
- jmp SHORT .chs1
-
- .chs2: stc ; return CF set for failure
-
- .chs3: pop es
- ret ; returns CF = 0 if match else CF = 1
- check_screen endp
-
- ; command_error - spits out error information and quits.
- ;
- ; Called with:
- ; SI -> diagnostic (null terminated string)
-
- command_error proc near ; SI -> diagnostic message
- push si ; save diagnostic pointer
- cmp pan_state,PS_LOADED ; check the state
- jbe .ce1 ; if Pandora is in control
- cli ; else turn off interrupts
-
- ; Prepare screen for messages
-
- .ce1: mov al,init_video_mode ; revert to original video mode
- mov ah,00h ; BIOS set video mode
- int 10h ; which incidentally clears the screen
-
- mov si,OFFSET ferrmsg ; "Fatal error in Pandora Command: "
- call ttyz
- call reconstruct_command ; recreate text of command
- call ttyz ; and display it
- mov si,OFFSET crlfz
- call ttyz
- pop si ; display the specific diagnostic
- call ttyz
- cmp pan_state,PS_LOADED ; check the state
- ja .ce2 ; if Pandora is not in control
- jmp c_Quit ; then get out quick
-
- .ce2: mov si,OFFSET bomb_msg2 ; else wait for confirmation
- call ttyz
- xor ax,ax ; wait for input
- pushf
- call [i_BIOS_kb] ; int 16h
- xor ax,ax ; do a warm boot
- mov ds,ax
- mov ax,1234h
- mov ds:[472h],ax
- db 0EAh ; JMP FFFF:0000
- dw 0000h, 0FFFFh
-
- bomb_msg2 db CR,LF,'Press the [Space Bar] to reboot.',0
- ferrmsg db 'Fatal error in Pandora command:',CR,LF,0
- command_error endp
-
- ; compare_strings
- ;
- ; Called with:
- ; SI and DI -> strings to be compared
- ; CX = length
- ;
- ; Returns:
- ; CX, SI and DI unchanged
- ; flags: see CMPS instruction
-
- compare_strings proc near
- push si
- push di
- push cx
- repe cmpsb
- pop cx
- pop di
- pop si
- ret
- compare_strings endp
-
- ; Copy a null-terminated string.
- ;
- ; Called with:
- ; SI -> source string (null terminated)
- ; DI -> destination
- ;
- ; Returns:
- ; SI = garbage
- ; DI -> null at end of the copy
-
- copyz proc near
-
- .cz1: lodsb ; copy each byte including the null
- stosb
- test al,al
- jnz .cz1 ; continue until null
- dec di ; DI -> null at end of copied string
- ret
- copyz endp
-
- ; Copy a delimited terminated string to 'line_buffer'.
- ;
- ; Called with:
- ; SI -> "string"
- ;
- ; Returns:
- ; SI -> copy
- ; DI = garbage
-
- copy_quoted_string proc near
- mov di,OFFSET line_buffer ; DI -> standard destination
- push di
- lodsb ; AL = delimiter
- mov ah,al ; keep in AH
-
- .cqs1: lodsb ; AL = next character
- test al,al ; allow missing closing delimiter
- jz .cqs3 ; if end of string
- cmp al,ah ; delimiter?
- jz .cqs3
- stosb
- jmp SHORT .cqs1
-
- .cqs3: xor ax,ax ; store null terminator
- stosb
- pop si ; SI -> line_buffer
- ret ; returns SI -> copied string
- copy_quoted_string endp
-
- ; copy a null-terminated string
- ;
- ; Called with:
- ; DS:SI -> source
- ; ES:DI -> destination
- ;
- ; Returns:
- ; DS:SI -> null terminator of source
- ; ES:DI -> null terminator of copy
-
- copy_string proc near
-
- .cs1: lodsb
- stosb
- test al,al
- jnz .cs1
- dec si
- dec di
- ret
- copy_string endp
-
- ; decode a decimal number
- ;
- ; Called with:
- ; SI -> numeric string
- ;
- ; Returns:
- ; SI -> first non-numeric character in string
- ; AX = decoded value
-
- decode_decimal proc near
- xor bx,bx ; decode value into BX
- xor cx,cx ; keep sign indication in CH
- cmp BYTE PTR [si],'+' ; initial + or - is allowed
- je .dec0
- cmp BYTE PTR [si],'-'
- jne .dec1
- inc ch
-
- .dec0: inc si ; push SI past sign
-
- .dec1: xor ax,ax
- lodsb ; AX = next character
- sub al,'0' ; check if it's a digit
- jl .dec2
- cmp al,9
- jg .dec2
- xchg ax,bx ; AX = cumulative total
- mul ten ; multiply by ten, ignore overflow into DX
- add bx,ax ; and add in the new digit
- jmp .dec1
-
- .dec2: mov ax,bx ; AX = decoded value for return
- test ch,ch ; + or -
- jz .dec3 ; if +
- neg ax ; if - then negate it
-
- .dec3: dec si ; back up SI to first non-digit
- ret
-
- ten dw 10
- decode_decimal endp
-
- ; Decode a duration (ticks/seconds/minutes)
- ;
- ; Called with:
- ; SI -> encoded duration
- ;
- ; Returns:
- ; If decoded successfully,
- ; CF = 0, and
- ; AX = value decoded into ticks
- ; If error then
- ; CF = 1
-
- decode_duration proc near
- call decode_decimal ; decode decimal count
- test ah,ah ; 0 - 255 allowed
- jnz .dur2 ; if out of bounds
- mov cx,ax ; CX = number
- call skip_whitespace ; skip to units
- jz .durs ; if no units then use seconds
- call isletter ; check that units starts with a letter
- jc .dur2 ; give error if it doesn't
- cmp al,'T' ; ticks?
- je .durt
- cmp al,'S' ; seconds?
- je .durs
- cmp al,'M' ; minutes?
- jne .dur2
- cmp cl,60 ; 60 minutes is the max
- jg .dur2
- mov ax,1092 ; AX = number of ticks in a minute
- mul cx ; get AX = number of seconds
- jmp SHORT .dur0
-
- .durs: mov al,18 ; multiple by 18.25 to approximate 18.2
- mul cl
- shr cx,1
- shr cx,1
- add ax,cx
- jmp SHORT .dur0
-
- .durt: mov ax,cx ; AX = tick count
-
- .dur0: clc
- ret
-
- .dur2: stc
- ret
- decode_duration endp
-
- ; decode a hex number
- ;
- ; Called with:
- ; SI -> numeric string
- ;
- ; Returns:
- ; SI -> first non-numeric character in string
- ; AX = decoded value
-
- decode_hex proc near
- xor bx,bx ; put decoded value in bx
-
- .hex1: lodsb ; AL = next character
- cmp al,'0' ; check if it's a hexit
- jl .hex2
- cmp al,'9'
- jg .hex2
- sub al,'0'
-
- .hex0: mov cl,4 ; multiply result so far by 16
- shl bx,cl
- add bx,ax ; and add in the new hexit
- jmp .hex1
-
- .hex2: call isletter
- jc .hex3 ; if not a letter
- cmp al,'G'
- jae .hex3
- sub al,'A'-10
- jmp .hex0
-
- .hex3: mov ax,bx ; set result in AX
- dec si ; point SI to terminator
- ret
- decode_hex endp
-
- ; decode a time in the "HH:MM" format
- ;
- ; Called with:
- ; SI -> numeric string
- ;
- ; Returns:
- ; SI -> first non-numeric character in string
- ; AX = decoded value
- ;
- ; Side effects:
- ; Sets 'time_argument' to decoded value
-
- decode_time proc near
- call decode_decimal ; decode hours
- mov hour,al ; save
- inc si ; puch pointer past ':'
- call decode_decimal ; decode minutes
- mov minute,al ; save that
- mov ax,time_argument
- ret
- decode_time endp
-
- ; delay - pause for a given count of clock ticks.
- ;
- ; Called with:
- ; CX = number of 18.2-to-a-second ticks
-
- CLOCK = 46Ch ; low-memory timer word
- delay proc near
- push es ; get ES = 0
- xor ax,ax
- mov es,ax
- mov ax,es:[CLOCK] ; AX = current clock value
-
- .del1: cmp ax,es:[CLOCK] ; count down changes in the clock
- je .del1
- mov ax,es:[CLOCK]
- loop .del1
-
- pop es
- ret
- delay endp
-
- ; display_string - display a null-terminated string on the screen.
- ;
- ; Called with:
- ; DX = screen position
- ; BL = video attribute
- ; SI -> string
-
- display_string proc near ; DX = screen position, BL = video attribute
- push es
- call set_video_address ; get ES:DI -> video buffer
- mov ah,bl ; AH = attribute
-
- .ds1: lodsb ; AL = next character from string
- test al,al ; ends at a null
- jz .ds2
- stosw ; pop into video memory
- jmp SHORT .ds1
-
- .ds2: pop es
- ret
- display_string endp
-
- ; Find the Master Environment Block
- ;
- ; Returns:
- ; CF = 0 if global environment table found
- ; and AX = segment address of global environment table
- ; CF = 1 and AX = 0 otherwise
-
- find_MEB proc near
- push bx
- push es
- xor ax,ax
- mov es,ax
- mov ax,es:[0BAh] ; get COMMAND.COM segment from 2E i.v.
- mov es,ax ; ES -> MCB for COMMAND.COM
- mov ax,es:[2Ch]
- test ax,ax
- stc
- jz .meb1
- clc
-
- .meb1: pop es
- pop bx
- ret
- find_MEB endp
-
- ; get_keyfile - read a keycode from the KeyFile file
- ;
- ; Called with:
- ; (nothing)
- ;
- ; Returns:
- ; AX = keycode and CF = 0
- ; or CF = 1 if EOF
-
- get_keyfile proc near
- mov ah,3Fh
- mov bx,keyfile_handle
- mov cx,1
- mov dx,OFFSET .gkpot
- int 21h
- jc .gkf1
- mov al,.gkpot ; AL = ASCII code
- ; translate to a keycode
- clc
-
- .gkf1: ret
-
- .gkpot db 0 ; for reading bytes into
- get_keyfile endp
-
- ; get_kiq - load a keycode from the keyboard input queue
- ;
- ; Called with:
- ; (nothing)
- ;
- ; Returns:
- ; AX = keycode and CF = 0
- ; or CF = 1 if kiq is exhausted
-
- get_kiq proc near
- mov si,kiq_first ; SI -> string of key codes
- call translate_key ; translate next character
- mov kiq_first,si ; update pointer
- ret
- get_kiq endp
-
- ; get_screen_position - decode a row-column spec. Note that the row and
- ; column numbers are counted from zero, and are
- ; deliberately not checked for validity.
- ; Called with:
- ; SI -> "<row> <column>"
- ;
- ; Stores the result in 'screen_position'.
-
- get_screen_position proc near
- call decode_decimal ; decode row number
- mov n_row,al
- call skip_whitespace ; skip separator
- call decode_decimal ; decode column number
- mov n_col,al
- ret
- get_screen_position endp
-
- ; get_script - determines the script-file name from the command-line
- ; argument, loads and preprocesses the file.
- ;
- ; On return:
- ; AX = number of bytes read
-
- get_script proc near
- mov si,80h ; SI -> command line
- xor ax,ax ; first character holds the lebgth
- lodsb
- mov bx,ax ; AX = BX = character count
- mov [si+bx],ah ; replace terminator with null
- call skip_whitespace ; skip any spaces
- mov dx,OFFSET .gsB ; "ERROR: No script file specified"
- jz .gs6 ; if no filename given
- mov dx,si ; DX -> filename
- xor ax,ax
-
- .gs1: lodsb ; see if name includes an extension
- cmp al,'.' ; that is a period
- jne .gs2
- mov ah,al ; note period in AH
-
- .gs2: cmp al,' ' ; take any control character as the end
- ja .gs1 ; this is chancy but...
-
- cmp ah,'.'
- je .gs3 ; if an extension was given
- mov di,si ; else append the default
- dec di
- mov si,OFFSET pan_extension
- mov cx,5 ; which is 5 characters long with null
- rep movsb
-
- .gs3: mov ax,3D00h ; open the command file
- int 21h
- mov dx,OFFSET .gsC
- jc .gs7 ; if open returned an error
- mov file_handle,ax ; else save the handle
- call load_script ; load the script from the file
- jc .gs7 ; if there was something wrong with it
- mov ah,3Eh ; DOS close file
- mov bx,file_handle
- int 21h
- cmp if_nest_level,0
- jnz .gs4 ; if Ifs and EndIfs don't match
- mov ax,di ; return size of script
- sub ax,OFFSET script_buffer
- clc
- ret
-
- .gs4: mov dx,OFFSET .gsD ; complain
-
- .gs6: stc
-
- .gs7: ret
-
- .gsB db 'Pandora Error: No script file specified$'
- .gsC db 'Pandora Error: Cannot find script file$'
- .gsD db "Pandora Error: Unbalanced Ifs and EndIfs$"
- get_script endp
-
- ; is_digit - checks if character is an ASCII-coded digit
- ;
- ; Called with:
- ; AL = character
- ;
- ; Returns:
- ; CF = 0 if character is a digit ('0' - '9')
- ; CF = 1 otherwise
-
- is_digit proc near
- cmp al,'0' ; is it a numeric ASCII code?
- jb .id1
- cmp al,'9'
- ja .id1
- clc
- ret
-
- .id1: stc
- ret
- is_digit endp
-
- ; isletter - check and fold a letter
- ;
- ; Called with:
- ; al = ASCII code
- ;
- ; Returns:
- ; CF = 0 if AL contains a letter
- ; 1 otherwise
- ; AL = ASCII code, folded to uppercase if letter
-
- isletter proc near
- cmp al,'A'
- jb .let1
- cmp al,'Z'
- jbe .let2
- cmp al,'a'
- jb .let1
- cmp al,'z'
- ja .let1
-
- .let2: and al,0DFh ; fold
- ret
-
- .let1: stc
- ret
- isletter endp
-
- ; loader - attempt to load a target program given a filename.
- ; Note that the child is loaded and given as its environment a copy of the
- ; master environment. This is so that 'DOS "set xxx=yyy"' commands can be
- ; given in Pandora scripts to establish a suitable environment for the child.
- ;
- ; Called with:
- ; SI -> program filename
-
- loader proc near
- call normalize ; copy filename and arguments
- cmp env_inherit,0 ; which environment do we pass on?
- mov ax,ds:[2Ch] ; AX = segment of our environment
- je .load2 ; if child to get Pandora's own
- call find_MEB ; else get AX -> master env table
-
- .load2: mov env_seg,ax ; set environment for child
-
- mov ax,4B01h ; DOS Load Program and Return function
- mov bx,OFFSET parameter_block ; BX -> parameter block
- mov dx,si ; DX -> filename
- int 21h ; returns in child context
- jc .load1 ; unless load attempt failed
- mov child_size,bx ; save size of program
- mov ah,51h ; DOS get PSP address
- int 21h ; returns BX = segment of PSP
- mov child_psp,bx ; save that
- mov al,50h ; DOS set PSP address
- mov bx,cs ; set process back to us
- int 21h
- mov pan_state,PS_LOADED ; set state to PS_LOADED
- clc
-
- .load1: ret
- loader endp
-
- ; load_script - loads the script from a given opened file.
- ;
- ; Called with:
- ; 'file_handle' containing the handle of the file.
- ;
- ; Returns:
- ; CF = 0 if script was loaded succesfully
- ; CF = 1 if an error occurred
-
- load_script proc near
- mov di,OFFSET script_buffer
-
- .ls1: mov bx,file_handle
- call read_line ; read one line = one command
- jc .ls3 ; on EOF
- call skip_whitespace ; skip any initial blanks
- test al,al ; blank line?
- jz .ls1 ; yes, ignore it
- cmp al,'*' ; comment line?
- je .ls1 ; yes, ignore it
- mov bx,OFFSET command_keys ; identify the command
- call match_key ; returns AL = command index if valid
- jnz .ls4 ; if it's invalid
- push di ; save pointer to start of command
- inc di ; reserve a byte for command length
- stosb ; store command index
- call skip_whitespace ; skip any blanks after command
-
- .ls2: lodsb ; copy the rest of the line
- stosb
- test al,al ; including the null terminator
- jnz .ls2
- pop bx ; BX -> start of command
- mov ax,di ; AX -> end of command
- sub ax,bx ; AX = length of command
- mov [bx],al ; store that
-
- ; Do If/EndIf checking
-
- xor ax,ax
- inc bx
- mov al,[bx] ; AX = command index
- push ax
- mul command_entry_size
- mov bx,ax ; BX = offset of command table entry
- xor ax,ax ; get AX = the command type
- mov al,BYTE PTR [command_table+PC_TYPE+bx]
- mov bx,ax
- pop ax ; call preprocessor with AX = index
- call [preprocessing_table+bx]
- jnc .ls1 ; if no error
- ret ; else return with CF set
-
- .ls3: xor ax,ax ; zero-length command at end of script
- stosw
- ret
-
- .ls4: call ttyz ; display the offending line
- mov dx,OFFSET .lsA ; DX -> "Invalid command"
- stc
- ret
-
- .lsA db CR,LF,'Pandora Error: Invalid command.$'
- load_script endp
-
- ; Procedures for preprocessing commands:
-
- pp_regular proc near ; for regular commands there is nothing to do
- cmp al,LABEL_INDEX ; unless this was a label command
- jne .ppr1
- mov al,3 ; store length for a SetIf
- stosb
- mov al,SETIF_INDEX ; insert a SetIf
- stosb
- mov al,if_nest_level
- stosb
-
- .ppr1: clc
- ret
- pp_regular endp
-
- pp_If proc near ; for Ifs increment the nest level
- inc if_nest_level
- clc
- ret
- pp_If endp
-
- pp_Else proc near ; for Else ensure it's in an If block
- cmp if_nest_level,0
- jnz .ppe1
- mov dx,OFFSET .ppeA ; complain about misplaced Else
- stc
-
- .ppe1: ret
-
- .ppeA db "Pandora Error: 'Else' command not in If/EndIf clause$"
- pp_Else endp
-
- pp_EndIf proc near ; For EndIf decrement the nest level
- cmp if_nest_level,0
- jnz .ppf1
- mov dx,OFFSET .ppfA ; complain about dangling EndIf
- stc
- ret
-
- .ppf1: dec if_nest_level
- clc
- ret
-
- .ppfA db "Error: EndIf found with no matching If$"
- pp_EndIf endp
-
- ; match_key - match a string to a set of keys. The comparison is for
- ; letters only and is case insensitive.
- ;
- ; Called with:
- ; BX -> list of keys
- ; SI -> string to be matched
- ;
- ; Returns:
- ; If match made: ZR = 1 and AX = index of the key
- ; Else: ZR = 0
-
- match_key proc near
- push di
- call skip_whitespace ; skip any leading blanks
- mov di,si ; SI, DI -> first non-white char
- xor cx,cx ; count keys in CX
-
- .mat1: mov si,di ; SI -> target of match
-
- .mat2: mov ah,[bx] ; AH = character to compare against
- inc bx ; bump the pointer
- test ah,ah ; check for end of key
- jz .mat4 ; we got a match
- lodsb ; AL = next character of string
- cmp al,' ' ; match up to blank or control char
- jbe .mat3
- cmp al,ah ; do the real comparison
- je .mat2 ; if they match then keep trying
- xor al,20h ; else switch case of string char
- cmp al,ah ; and compare that way
- je .mat2
-
- .mat3: cmp BYTE PTR [bx],0 ; push BX to end of current key
- pushf
- inc bx
- popf
- jnz .mat3
- inc cx ; increment key counter
- cmp BYTE PTR [bx],0 ; have we tried all keys?
- jnz .mat1 ; no, try next
-
- .mat35: mov si,di ; no match, return SI as it was
- inc cx ; just to ensure that ZR = 0
- pop di
- ret ; no match: return ZR = 0, SI as on entry
-
- .mat4: lodsb ; AL = next character of string
- cmp al,' ' ; it should be blank or control char
- ja .mat35
- dec si
- xor ax,ax ; set ZR
- mov ax,cx ; AX = key number
- pop di
- ret ; match: return ZR = 1, AX = key number
- match_key endp ; and SI -> character past key
-
-
- ; normalize - normalize translates a string containing control characters
- ; in the form '^X' while copying it to line_buffer.
- ;
- ; Called with:
- ; SI -> delimited string
- ;
- ; Returns:
- ; SI -> normalized string in 'line_buffer'
- ; DI -> end of normalized string
- ; CX = length
-
- normalize proc near
- mov di,OFFSET line_buffer
- push di
- xor ax,ax
- lodsb ; AL = delimiter
- or ah,al ; keep in AH
- jz .nor3 ; if no argument
-
- .nor1: lodsb ; AL = next character
- test al,al
- jz .nor3 ; if end of input
- cmp al,ah ; end of delimited string?
- je .nor3
- cmp al,' '
- jb .nor1 ; ignore "real" control characters
- cmp al,'^'
- jne .nor2
- lodsb
- cmp al,'^' ; ^^ means ^
- je .nor2
- and al,1Fh ; make a control
-
- .nor2: stosb ; and store into string
- jmp SHORT .nor1
-
- .nor3: xor ax,ax ; store null terminator
- mov [di],al
- pop si ; SI -> line_buffer
- mov cx,di ; calculate new length
- sub cx,si
- ret ; returns SI -> normalized string, CX = length
- ; DI -> end of normalized string
- normalize endp
-
- ; read_line - read one line from a file into line_buffer.
- ;
- ; Called with:
- ; BX = file handle
- ;
- ; Returns:
- ; If data read then: CF = 0, SI -> line, CX = length
- ; Else CF = 1 (implies end-of-file)
-
- read_line proc near
- mov si,OFFSET line_buffer ; SI -> line_buffer
- mov cx,1 ; read one byte at a time
-
- .re1: mov ah,3Fh ; DOS read function
- mov dx,si ; DS:DX -> buffer
- int 21H
- jc .re5 ; if read error
- test ax,ax
- jz .re4 ; if EOF
- mov al,[si] ; AL = byte just read
- cmp al,1Ah ; check for Control-Z EOF
- je .re4 ; be good to folks who use ancient editors
- cmp al,' ' ; control character?
- jb .re2 ; if so
- inc si ; else bump buffer pointer
- cmp si,OFFSET line_buffer+127; and check for overflow
- jb .re1 ; handle over-long lines ungracefully!
-
- .re3: xor ax,ax ; null terminate the line
- mov [si],al
- mov cx,si ; calculate its length
- mov si,OFFSET line_buffer ; SI -> line_buffer
- sub cx,si ; CX = line length
- clc
- ret ; return with CF zero and SI -> input, CX = length
-
- .re2: cmp al,CR ; check for CR
- jne .re1 ; and discard other control characters
- jmp SHORT .re3 ; end the line on CR
-
- .re4: cmp si,OFFSET line_buffer ; accept a last line with no CR
- jne .re3
-
- .re5: stc
- ret ; EOF or read error, return with CF set
- read_line endp
-
- ; reconstruct_command - reconstruct the text form of the current
- ; command.
- ;
- ; Returns:
- ; SI -> command key
-
- reconstruct_command proc near
- mov di,OFFSET line_buffer ; reconstruction done here
- push di ; save a copy for later
- mov si,current_command ; SI -> internal form of command
- xor ax,ax ; get AX = command index
- lodsb
- mul command_entry_size ; calculate AX = offset of entry
- push si
- mov si,ax
- mov si,WORD PTR [command_table+PC_KEY+si]
- call copyz ; copy null-terminated string
- mov al,' ' ; put in a blank
- stosb
- pop si
- call copyz ; and copy the arguments
- pop si ; return SI -> reconstructed text
- ret
- reconstruct_command endp
-
- ; resolve jumps - replace labels in Jump commands with offsets.
-
- resolve_jumps proc near
-
- .rj1: mov si,command_ptr ; SI -> next command
- xor ax,ax
- lodsb ; AX = command length
- test ax,ax
- jz .rj4 ; at end of script
- add command_ptr,ax ; update the command pointer
- lodsb ; AX = command index
- cmp al,JUMP_INDEX ; is it a jump?
- jne .rj1
-
- mov di,si ; DI -> target label
- mov si,OFFSET script_buffer ; scan through script for label
- xor cx,cx
-
- .rj2: add si,cx ; SI -> next command
- xor ax,ax
- lodsb ; AX = length of current command
- test ax,ax
- jz .rj3 ; at end of script
- sub ax,2
- mov cx,ax ; CX = length - 2
- lodsb ; AX = command index
- cmp al,LABEL_INDEX ; is it a label?
- jne .rj2
- call compare_strings
- jne .rj2
- add si,cx ; SI -> next command
- mov [di],si ; overwrite label in jump
- jmp SHORT .rj1
-
- .rj3: mov si,di ; SI -> label
- call ttyz ; display the offending line
- mov dx,OFFSET .rjA ; DX -> "ERROR: Label not found."
- stc
-
- .rj4: ret
-
- .rjA db CR,LF,'Pandora Error: Label not found.$'
- resolve_jumps endp
-
- ; restore_vector - restores a value into an interrupt vector
- ;
- ; On entry:
- ; AL = vector number
- ; DS:BX = address at old vector is stored
- ;
- ; Destroys AX.
-
- restore_vector proc near
- push si
- push es
- xor ah,ah ; calculate offset of vector
- shl ax,1 ; = number * 4
- shl ax,1
- mov si,ax ; SI = offset of vector
- xor ax,ax
- mov es,ax ; ES:SI -> vector
- pushf
- cli ; interrupts off during switch
- mov ax,[bx] ; move in the saved value
- mov es:[si],ax
- mov ax,[bx+2]
- mov es:[si+2],ax
- popf
- pop es
- pop si
- ret
- restore_vector endp
-
- ; run_it - transfer control to child program.
-
- run_it proc near
- mov ax,5000h ; DOS set PSP address
- mov bx,child_psp ; BX = PSP of loaded program
- int 21h
-
- cli
- mov pan_sp,sp ; save own SP
- mov ss,child_ss ; set child's stack
- mov sp,child_sp
- sti
-
- pop ax ; dump original drive valid flag
- mov ax,cx ; set real drive valid flag
- push child_cs ; set stack to "return" to child
- push child_ip
-
- mov es,child_psp
- mov ds,child_psp ; DS = ES = child PSP
-
- mov WORD PTR es:[000AH],OFFSET child_return
-
- xor bx,bx
- xor dx,dx
- xor bp,bp
- xor si,si
- xor di,di
- mov cs:in_pan_flag,bl ; clear in-Pandora flag
- retf ; Note that we are in a NEAR procedure
-
- child_return: ; returns in Pandora context except DS = ???
- ; SP restored from Load operation not from Go
- mov ax,cs ; make sure DS and ES are set
- mov ds,ax
- mov es,ax
- mov sp,pan_sp ; restore SP saved just above
- call unset_traps ; should this be here ??? ***
- mov al,pan_state ; check state while resetting it
- cmp al,PS_OBIT ; waiting for this?
- je .cr1 ; yes, continue
- mov pan_state,PS_QUIT ; set state so death can occur and
- jmp c_Quit ; quit if chump did not wait for die
-
- .cr1: mov pan_state,PS_INITIAL ; revert to initial state
- mov time_out,0 ; to let interpretation continue
- ret
- run_it endp
-
- ; search_env - searches the local environment for a string
- ;
- ; Called with:
- ; SI -> name
- ;
- ; Returns:
- ; If string found then
- ; CF = 0
- ; DS:SI -> string (**** Note: DS = environment segment ****)
- ; Else
- ; CF = 1
-
- search_env proc near
- mov es,ds:[2Ch] ; get ES -> environment segment
- xor di,di ; ES:DI -> start of environment
- mov bx,si ; keep BX -> name
-
- .se1: mov si,bx ; SI -> name
-
- .se2: lodsb
- test al,al
- jz .se4 ; if end of name
- call isletter ; to fold to uppercase
- mov ah,es:[di]
- inc di
- xchg al,ah
- call isletter ; fold other to uppercase
- cmp al,ah
- je .se2
-
- ; Mismatch on current name. Push DI to start of next name.
-
- .se3: dec di
- xor ax,ax
- mov cx,-1
- repne scasb
- cmp es:[di],al
- jne .se1
- mov ax,ds
- mov es,ax
- stc
- ret
-
- ; Matched a name. Check that string comes next.
-
- .se4: cmp BYTE PTR es:[di],'='
- jne .se3
-
- .se5: inc di
- cmp BYTE PTR es:[di],' '
- je .se5
- mov si,di
- push ds ; exchange DS and ES
- push es
- pop ds
- pop es
- clc
- ret
- search_env endp
-
- ; set_traps - capture the timer and BIOS-keyboard-function interrupts.
-
- set_traps proc near
- mov dx,OFFSET timer_intercept ; replace timer interrupt
- mov al,8h
- mov bx,OFFSET i_timer
- call set_vector
-
- mov dx,OFFSET BIOS_kb_intercept ; replace BIOS-kb interrupt
- mov al,16h
- mov bx,OFFSET i_BIOS_kb
- call set_vector
- ret
- set_traps endp
-
- ; set_vector - copies the contents of an interrupt vector then stores
- ; a new value in the vector.
- ;
- ; On entry:
- ; AL = vector number
- ; DS:DX = new address for interrupt vector
- ; DS:BX = address at which to store old vector
- ;
- ; Destroys AX and BX.
-
- set_vector proc near
- push si
- push es
- xor ah,ah ; calculate offset of vector
- shl ax,1 ; = number * 4
- shl ax,1
- mov si,ax ; SI = offset of vector
- xor ax,ax
- mov es,ax ; ES:SI -> vector
- pushf
- cli ; interrupts off during switch
- mov ax,es:[si] ; move out the old
- mov [bx],ax
- mov ax,es:[si+2]
- mov [bx+2],ax
- mov es:[si],dx ; move in the new
- mov ax,ds
- mov es:[si+2],ax
- popf
- pop es
- pop si
- ret
- set_vector endp
-
- ; set_video_address - set the video address corresponding to a given
- ; row and column.
- ;
- ; Called with:
- ; DX = screen position (DH = row, DL = column)
- ;
- ; Returns:
- ; ES:DI -> corresponding word in video buffer memory
-
- set_video_address proc near ; DX = screen position
- mov ax,video_segment
- mov es,ax
- xor di,di ; ES:DI -> start of video buffer
- mov al,dh ; DH = row number
- mul screen_columns
- xor dh,dh
- add ax,dx
- add di,ax
- add di,ax
- ret ; returns ES:DI -> word in video buffer
- set_video_address endp
-
- ; Handle a CapsLock, NumLock or ScrollLock...
- ;
- ; Called with:
- ; DL = Lock bit in keyboard flags
-
- ShiftLock proc near
- mov bx,OFFSET on_off ; BX -> "ON/OFF"
- call match_key ; check the argument
- jne .sl1 ; if not "ON" nor "OFF"
- push es
- xor bx,bx
- mov es,bx
- mov dh,dl
- not dh ; start by setting Lock Off
- and es:[417h],dh
- test ax,ax ; On or Off?
- jz .sl2 ; if Off
- or es:[417h],dl ; else set to On
-
- .sl2: pop es
- ret
-
- .sl1: mov si,OFFSET .slmsg ; "...should have argument On or Off"
- jmp command_error
-
- .slmsg db 'Caps/Num/ScrollLock should have argument "On" or "Off"',0
- ShiftLock endp
-
- ; skip_whitespace - skip blanks and tabs in a string.
- ;
- ; Called with:
- ; SI -> string
- ;
- ; Returns:
- ; SI -> first character that is neither a blank nor a tab
- ; AL = that character
-
- skip_whitespace proc near
-
- .sw1: lodsb
- cmp al,' '
- je .sw1
- cmp al,09h ; check for TAB
- je .sw1
- dec si
- test al,al
- ret ; returns SI -> first non-white char, AL = said char
- skip_whitespace endp ; and ZR = 1 if character is a null
-
- ; stuff_keys - stuff keycodes into the BIOS keyboard buffer.
-
- stuff_keys proc near
- pushf ; save interrupt flag
- push es
- mov es,kbb_segment ; ES = keyboard-buffer segment
- cli ; no interrupts while poking key buffer
-
- .sk0: mov bx,es:[KBB_TAIL] ; get tail
- mov di,bx ; and copy
- inc bx ; bump tail pointer
- inc bx
- cmp bx,es:[KBB_END]
- jne .sk1
- mov bx,es:[KBB_START] ; if wrapped around
-
- .sk1: cmp bx,es:[KBB_HEAD] ; any room in buffer
- mov ax,1 ; for timeout
- je .sk3 ; if not...
-
- pop es
- mov ax,key_getter ; AX -> proc to load a keycode
- call ax ; returns AX = keycode
- push es
- jc .sk4 ; if at end of string
- mov es,kbb_segment ; ES = keyboard-buffer segment
- stosw ; store scan code and ASCII to KBB
- mov es:[KBB_TAIL],bx ; update tail
-
- mov ax,type_rate ; AX = inter-key delay (in ticks)
- test ax,ax
- jz .sk0 ; if zero just continue
-
- .sk3: mov time_out,ax ; set new timeout
- jmp SHORT .sk5
-
- .sk4: mov recall_address,0 ; stop recall
-
- .sk5: pop es
- popf
- ret
- stuff_keys endp
-
- ; terminate - terminate the current program.
-
- terminate proc near
- mov ax,4C00h ; DOS terminate a program
- int 21h
- terminate endp
-
- ; test_eks - test for extended keyboard services.
- ;
- ; This code is based on that published in PC Magazine of June 12, 1990. Jeff
- ; Prosise provides this code as part of his Tutor column on page 384.
- ;
- ; Called with:
- ; (nothing)
- ;
- ; Returns:
- ; AX = 0 if the BIOS appears to support extended keyboard services.
- ; AX non-zero if it does not...
-
- test_eks proc near
- push es
- mov ax,40h ; clear the keyboard buffer
- mov es,ax
- mov ax,es:[1Ah]
- mov es:[1Ch],ax
- mov ax,05FFh ; try to insert a keycode
- mov cx,0FFFFh ; into the buffer
- int 16h
- or al,al ; not supported if AL is returned NZ
- jnz .eks1
- mov ah,10h ; read back the keycode
- int 16h
- xor ax,0FFFFh ; to see if it matches
-
- .eks1: ret
- test_eks endp
-
- ; translate_key - translates a character in keyboard format
- ;
- ; Called with:
- ; SI -> string of encoded key symbols
- ;
- ; Returns:
- ; CF = 0 if character available, and
- ; AX = key code suitable for insertion into BIOS keyboard buffer
- ; DL = shift status for character
- ; CF = 1 if end-of-string
-
- translate_key proc near ; SI -> key spec
- push bx ; save all registers but those
- push cx ; used to return stuff
- push di
-
- .tra1: xor dx,dx ; prepare DL to hold shift information
-
- ; We start by checking for a caret which is usually a Ctrl-shift indicator
-
- .tra2: cmp [si],BYTE PTR '^' ; Ctrl-shifted character?
- jne .tra3
- inc si
- cmp [si],BYTE PTR '^' ; doubled?
- je .tra8 ; send character
- or dl,04h ; set "Ctrl key is down" bit in status
-
- .tra3: cmp [si],BYTE PTR '[' ; special-key delimiter?
- jne .tra8
- inc si ; push pointer past \
- cmp [si],BYTE PTR '[' ; doubled?
- je .tra8 ; '[[' means '['
- mov bx,si ; save pointer to '['
-
- .tra4: lodsb ; search for closing ']'
- test al,al ; or end of string
- jz .tra6 ; if no closing ']'
- cmp al,']'
- jne .tra4
- dec si
- mov BYTE PTR [si],0 ; replace the ']' with a null
- mov si,bx ; SI -> keyname
- mov bx,OFFSET shiftname_list; check the list of shift-key names
- call match_key ; look it up
- jne .tra5 ; if no match
- inc si ; push SI past the null
- mov bx,ax
- or dl,[shiftbits+bx] ; or bit for shift key into DL
- jmp SHORT .tra2
-
- .tra5: mov bx,OFFSET keyname_list ; try other named keys
- call match_key ; look it up
- jne .tra6 ; if no match
- inc si ; push SI past the null
- mov bx,ax
- mov ah,[key_scans+bx] ; AH = scan code
- xor al,al ; AL = zero
- jmp SHORT .tra9
-
- .tra6: mov al,[si] ; AL = character following '['
- call is_digit ; only valid thing now is a decimal
- jc .tra8 ; code of exactly three digits
- xor ax,ax
- call decode_decimal ; decode the code
- cmp BYTE PTR [si],']'
- stc
- jne .tra12
- inc si ; push SI past ']'
- test al,al
- jz .tra1 ; zero is invalid
- test ah,ah
- jz .tra11 ; accept only codes between 1 and 127
-
- .tra7: jmp .tra1 ; need a long jump here
-
- .tra8: xor ax,ax ; load and return literal ASCII
- lodsb
- test al,al ; test for end of string
- stc ; at end we return with CF set
- jz .tra12
- js .tra11 ; if extended ASCII (no scan code)
- mov bx,ax
- mov ah,[scan+bx] ; AH = scan code
- xor bx,bx ; check if we need to add a Shift
- mov bl,ah
- add bx,bx
- add bx,OFFSET No_shift
- cmp [bx],al
- je .tra9 ; if char matches without a Shift
- or dl,02h ; assume a Left Shift
-
- ; Convert ASCII and scan codes according to shifts
-
- .tra9: test dl,08h ; Alt takes precedence
- mov bx,OFFSET Alt_shift
- jnz .tra10
- test dl,04h ; Ctrl is next
- mov bx,OFFSET Ctrl_shift
- jnz .tra10
- test dl,03h ; Shift is lowest
- mov bx,OFFSET Shift_shift
- jnz .tra10
- mov bx,OFFSET No_shift
-
- .tra10: xchg al,ah ; get scan code in AL
- xor ah,ah
- add ax,ax ; convert to word index
- add bx,ax ; BX -> entry in shift table
- mov ax,[bx] ; load revised codes
- test ax,ax ; zero entry means key combination
- jz .tra7 ; generates nothing
-
- .tra11: clc ; return character and CF = 0
-
- .tra12: pop di
- pop cx
- pop bx
- ret
- translate_key endp
-
- ; ttyz - display a null-terminated string at the cursor using the BIOS.
- ;
- ; Called with:
- ; SI -> string
-
- ttyz proc near
- xor bx,bx ; assume page 0
-
- .tz1: lodsb ; do it one character at a time
- test al,al
- jz .tz2
- mov ah,0Eh ; using the BIOS
- int 10h
- jmp SHORT .tz1
-
- .tz2: ret
- ttyz endp
-
- ; unset_traps - remove traps set by set_traps.
-
- unset_traps proc near
- mov ax,x_timer_offset ; were traps set?
- or ax,x_timer_segment
- jz .uns1 ; skip if not
- mov al,8h ; remove timer intercept
- mov bx,OFFSET i_timer
- call restore_vector
- mov al,16h ; remove BIOS-keyboard intercept
- mov bx,OFFSET i_BIOS_kb
- call restore_vector
-
- .uns1: ret
- unset_traps endp
-
- ; Interrupt stack
-
- dw 80h DUP (0)
- interrupt_stack LABEL WORD ; stack used within interrupts
-
- ; Regular stack
-
- dw 80h DUP (0)
- regular_stack LABEL WORD ; stack for use within Pandora
-
- script_buffer db 0 ; script loaded starting here
- code ends
- end start