; VAX MACRO ASSEMBLY LANGUAGE CODE ; Programmer: David W. Deley (1987) ; ; This module is used in conjunction with the EDX editor. ; It is called using the TPU command: ; ; OUTSTR := CALL_USER( CODE, INSTR); ; ; CODE - Integer. Input. ; 4(AP) = address of P1. ; @4(AP) = value of P1. ; ; INPUT REQUEST CODE: ; The input request code is split into words. The high word indicates ; the general category of the request, the low word indicates the ; specific request within the category. This simplifies parsing. ; ; INSTR - Input string. ; 8(AP) = address of string descriptor. ; The string is passed by a fixed length descriptor of the form: ; ; ----------------------------------------- ; | class | dtype | string length | ; ----------------------------------------- ; | address | ; ----------------------------------------- ; ; on VMS 4 the fields are: ; length = nn (length of string) ; dtype = 2 (8-bit unsigned data DSC$K_DTYPE_BU) ; class = 1 (fixed length descriptor DSC$K_CLASS_S) ; address = xx (address of first byte of string) ; ; but on VMS 5 the fields are: ; length = nn (length of string) ; dtype = 14 (character string DSC$K_DTYPE_T) ; class = 0 (DSC$K_CLASS_Z unspecified. This doesn't work for some things) ; address = xx (address of first byte of string) ; ; Because of this we create our own string descriptor for the input ; string on the stack. The original string descriptor is copied onto ; the stack, then the class and dtype fields are filled in. ; ; OUTSTR - Output string. ; 12(AP) = address of output string descriptor. ; The string is passed by a dynamic string descriptor where: ; ; length = 0 (length of string) ; dtype = 14 (character string DSC$K_DTYPE_T) ; class = 2 (dynamic string descriptor DSC$K_CLASS_D) ; address = 0 (invalid address) ; ; Because the result string is dynamically allocated we use ; the system service run-time library routine STR$COPY_DX_R8 ; to return the string. ; ; The first 9 characters of the output string are reserved ; for RETCODE, the return status code number. The calling program ; strips the first 9 characters off the string and converts ; it to a return status code number using the INT() function. ; ; RETURN STATUS - R0 ; The return status is returned in R0. This module always places a ; SS$_NORMAL status in R0 when it returns. The only way an error ; status is returned is if an unexpected nasty error happens. If ; an error status is returned TPU will take the ON_ERROR - ; ENDON_ERROR action if one exists in the calling procedure. ; ; INPUT ITEM CODE CATEGORIES: ; ^x0001xxxx - SYSTEM (65536) ; ^x00010001 - LOCK FILE (65537) ; INSTR = filename ; ; ^x00010002 - UNLOCK FILE (65538) ; INSTR = filename ; ; ^x00010003 - SHOW LOGICAL (65539) ; INSTR = logical name to translate ; OUTSTR = logical name translation ; ; ^x00010004 - SHOW SYMBOL (65540) ; INSTR = DCL symbol to translate ; OUTSTR = symbol translation ; ; ^x00010005 - PRINT ERROR MESSAGE (65541) ; INSTR = string containing error number (in decimal) ; ; ^x00010006 - CHECK IF FILE IS LOCKED (65542) ; INSTR = string containing filename to check ; Return INCODE = (1 = file locked, 0 file not locked) ; ; ^x00010007 - SET DEFAULT DIRECTORY (65543) ; INSTR = string containing new directory to go to. ; ; ^x00010008 - DEFINE LOGICAL NAME (65544) ; INSTR = string containing logical name followed by translation. ; The string is of the form "log-nam value", where "log-nam" ; is the logical name to be defined and "value" is the ; value to be assigned to the logical name. One or more ; spaces must separate the two. ; ; ^x00010009 - SHOW IDENT NUMBER (65545) ; OUTSTR = Ident version number. ; ; ^x0001000A - DELETE FILE (65546) ; INSTR = Filename to delete. ; ; ^x0001000B - SET SYMBOL (65547) ; INSTR = symbol to set ; ; ; ^x0002000n - SENDING MESSAGE FLAGS (131072) ; n - Value of message flags setting ; This code is used when we recursively call ourselves to ; give ourselves the current value (0-15) of message flags. ; Used when a message is signaled. ; ; ; ^x0003000n - DIRECTORY (196608) ; n - Code used for reentry. ; ; ; ^x00040001 - TRANSLATE FROM EBCDIC TO ASCII (262145) ; INSTR = EBCDIC string ; OUTSTR = ASCII string ; ; ^x00040002 - TRANSLATE FROM ASCII TO EBCDIC (262146) ; INSTR = ASCII string ; OUTSTR = EBCDIC string ; ; ^x00040003 - INITIALIZE RANDOM NUMBER GENERATOR WITH PASSWORD (262147) ; INSTR = Password ; OUTSTR = Status ; ; ^x00040004 - ENCRYPT STRING (262148) ; INSTR = String to encrypt ; OUTSTR = Encrypted string ; ; ^x00040005 - DECRYPT STRING (262149) ; INSTR = String to decrypt ; OUTSTR = Decrypted string ; ; ^x0005000n - SORT (327680) ; n = 1. Preparse command line ; 2. Pass files and do sort (for file sort) ; 3. Postparse command line ; 4. Pass a record to sort. (Repeat until all records passed) ; 5. Do record sort ; 6. Receive a record in sorted order. (Repeat until all records received) ; 7. Cleanup record sort ; ; ^x0006000n - SPELL (393216) ; n = 1. Dictionary browse previous page ; n = 2. Dictionary browse using word ; n = 3. Dictionary browse next page ; n = 4. Spell textline ; n = 5. Spell guess ; n = 6. Accept word (add to accepted word list) ; n = 7. Add word to personal dictionary. ; n = 8. Dump commonwords list ;-- ; COMMENTS: ; 1. MODULE FORMAT ; There are four program sections (.PSECT) used: ; .PSECT STATIC RD,NOWRT,NOEXE,LONG,PIC !non-changing non-shareable (contains .ADDRESS or .ASCID references) ; .PSECT STATSHR RD,NOWRT,NOEXE,LONG,PIC,SHR !non-changing shareable (no .ADDRESS or .ASCID references) ; .PSECT DATA RD,WRT,NOEXE,LONG,PIC,NOSHR !changing data ; .PSECT CODE NOWRT,EXE,LONG,PIC,SHR !static code (shareable) ; STATSHR is used for static variables which don't change (excluding .ADDRESS and .ASCID) references) ; STATIC is used for static variables which are position dependent (.ADDRESS and .ASCID) ; DATA is used for variables which change ; CODE is used for the executable code ; ; By shareable I mean if EDX_CALLUSER is installed via VMS INSTALL with the ; /SHARE qualifier, then only one copy of shareable PSECTs will be in system ; memory, and all processes running EDX will share the same memory. PSECT ; CODE, for example, never changes and is the same for all processes. Some ; PSECTs are not shareable in this manner. PSECT DATA for example holds data ; which is process specific. Each process running EDX will have it's own ; copy of PSECT DATA. ; ; PSECT STATIC is not shareable because it contains .ADDRESS references (.ASCID ; also implies a .ADDRESS reference). The addresses are fixed up when this ; shareable image is loaded. This shareable image is loaded when it is first ; called, not at the startup of EDX. You may notice a slight delay the first ; time you do a DIRECTORY command, or any command which uses this shareable ; image. This is because the shareable image is being loaded. There is no ; delay for subsequent references after this image is loaded. ; ; This shareable image is loaded as a position independent module. The ; operating system decides where in memory to put it at load time, thus the ; base address of this module may be different for each user running EDX, ; and thus the .ADDRESS fixes applied at load time will be different, and ; PSECTs containing .ADDRESS (or .ASCID) references are not shareable. ; ; ; 2. INSTALLING EDX_CALLUSER AS A KNOWN IMAGE ; In most cases I do not recommend installing this EDX_CALLUSER shareable image ; file for the following reason. TPU loads the shareable image pointed to ; by the TPU$CALLUSER logical name by calling LIB$FIND_IMAGE_SYMBOL, which in ; turn calls SYS$IMGACT, which in turn calls IMG$OPEN_IMAGE which in turn ; calls RMS$OPEN specifying the FAB file options bit FAB$V_KFO (known file ; open, undocumented and unsupported for user use). RMS$OPEN first calls ; its internal subroutine RM$PRFLNM (process file name) which translates the ; logical TPU$CALLUSER passed to it, and then calls INS$KF_SCAN (known file ; scan) which searches it's database of known files for the specified file. ; ; Tests on our VMS 5.1-1 system show that RM$PRFLNM does not translate concealed ; logical names including concealed device names, whereas the known file list ; contains only physical device names, and as a result INS$KF_SCAN does not find ; the known file. RMS then goes on to find the file in the normal manner. ; ; Interesting things can also happen at this point if there exists a new higher ; version of the installed file. If the file is installed /OPEN, then the ; lower installed version will still be loaded. Even if the lower version is ; purged away, it will still be loaded because VMS INSTALL has the file open, ; and the file can not be deleted until VMS INSTALL closes it. So even though ; the file's name was removed from the directory by a $ PURGE or $DELETE ; command, the file still exists and will still be loaded. Remember this ; whenever you install a new version of a product. ; ; On the other hand, if the file is not installed /OPEN, and a higher version ; exists, then the higher version will be loaded. But, if the lower version ; is purged away, then the higher version will not be loaded, RMS will complain ; that the lower version has disappeared. ; ; ; 3. VMS CALLING STANDARD ; The VMS procedure calling standard is not strictly adhered to in that ; parameters are passed back and forth via registers rather than pushing ; them on the stack, and some procedures return parameters in registers. ; The VMS procedure calling standard specifies that a procedure preserve ; the contents of all registers except R0 and R1. ; ; 4. OPTIMIZATION ; To optimize the code, procedures that are often called are placed near ; the beginning, and procedures that are seldom called are placed near ; the end. This helps to minimize page faulting. ; ; David Deley May, 1988 Original ; David Deley Nov. 1988 New version compatible with VMS 5.0 ; David Deley Nov. 1989 v5.7 with string sort ; David Deley Mar. 1990 V6.0 with spelling checker dictionary ;------------------------------------------------------------------------------ ; System routines ; TPU$CALLUSER !Main entry point. Entered via TPU CALL_USER instruction. ; SHOW_ID !Show ident number ; FMTOUTSTR !Format output string ; EDX_SIGNAL !Signal message ; EDX_SIGMSG !Signal warning messages not signaled by TPU ; HANDLER !Error handler ; ; Display directory listing ; EDX_DIRECTORY !Display directory listing ; GETDEFDIRFLGS ! support for directory command ; ;Sort Routines: ; EDX_SORT !Main entry. ; SORT_PREPARSE !Preparse SORT command ; SORT_PASSFILES !Pass filenames for file sort ; SORT_POSTPARSE !Finish parsing SORT command ; SORT_DO_FILE !Do file sort ; SORT_RELEASE_REC !Give record to sort when using record sort ; SORT_RETURN_REC !Get record from sort when using record sort ; ; Spelling checker and dictionary ; EDX_SPELL !Spelling dictionary main entry ; SPELL_INIT !Initialize spelling checker ; SPELL_TEXTLINE !Spell check a line of text ; DIC_LOOKUP_WORD !Look up a word in the dictionary ; DIC_BROWSE !Browse through the dictionary ; DIC_BROWSE_PREV_PAGE ! support for browse ; DIC_BROWSE_WORD ! support for browse ; DIC_BROWSE_FILL ! support for browse ; SPELL_GUESS ! Guess the spelling of a word. From Vassar. ; SPELL_ACCEPT_WORD ! Insert word into accepted word tree list ; TRAVERSE_TREE ! debug routine for accepted tree list ; PRINT_NODE ! debug routine for accepted tree list ; ALLOCATE_NODE ! support routine for accepted tree list ; COMPARE_NODE ! support routine for accepted tree list ; SPELL_PERSDIC_ADD ! add word to personal dictionary ; DUMP_COMMONWORDS ! dump the commonword list ; ; Lock and unlock files ; LOCK_FILE !Lock a file preventing others from editing it ; UNLOCK_FILE !Unlock file ; EDX_CKFILK !Check if file is locked ; SRCH_LNKFABLST !Search our list of locked files ; EDX_PARSE !Parse a filename ; ; Miscellaneous ; EDX_SETDEF !Change users default directory ; SET_LOGICAL !Create a logical name ; SET_SYMBOL !Create a DCL symbol ; SHOW_LOGICAL !Show translation of a logical name ; SHOW_SYMBOL !Show translation of a DCL symbol ; DELETE_FILE !Delete a file ; TRA_EBC_ASC !Translate EBCDIC to ASCII ; TRA_ASC_EBC !Translate ASCII to EBCDIC ; ; Entrypt a buffer ; ENCRYPT_INIT !Initialize encryption algorythm ; ENCRYPT !Encrypt main entry ; HCKPWD !Hack password ; AUTODIN_CRC !Calculate AUTODIN II cyclic redundancy code ; DES_INIT !Data Encryption Standara initialization ; DES_ENCRYPT !Encrypt using Data Encryption Standard ;------------------------------------------------------------------------------ .TITLE EDX_CALLUSER $CHFDEF ;Include CHF$ definitions $CLIMSGDEF $DSCDEF ;Define DSC$ descriptor definitions $FABDEF ;Include FAB$ definitions $LNMDEF ;Include LNM$ definitions $NAMDEF ;Include NAM$ definitions $RMSDEF $SSDEF ;Include SS$ system condition code definitions $STSDEF $XABDATDEF $XABDEF $XABFHCDEF SET_MESSAGE_FLAGS=2 ;Code for recursive call to set message flags BUFLEN=256 ;Usual length of string buffers (evenly divisible by 4 for longword alignment) MAXLEN=960 ;Maximum length of line in buffer (evenly divisible by 4 for longword alignment) .PSECT DATA RD,WRT,NOEXE,LONG,PIC,NOSHR .ALIGN LONG INSTR:: .LONG 0 ;Address of instr descriptor OUTSTR:: .LONG 0 ;Address of outstr descriptor .MACRO RETURN MOVZBL #SS$_NORMAL,R0 RET .ENDM RETURN .MACRO CHECK_STATUS,?DEST BLBS R0,DEST PUSHL R0 ;save R0 status PUSHL R0 CALLS #1,EDX_SIGNAL POPL R0 ;restore R0 status DEST: .ENDM CHECK_STATUS .MACRO PUSHQ val MOVQ val,-(SP) .ENDM PUSHQ ;---------------------------------------------------------------------- ; OUTSTR := CALL_USER( INCODE, INSTR) .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY TPU$CALLUSER,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11> MOVAL HANDLER ,(FP) ; Establish anti-crashing handler ;Get incode MOVL 4(AP),R2 ;Address of incode to R2 MOVL (R2),R0 ;Incode to R0 MOVZWL R0,R6 ;Low word of input integer to R6 EXTZV #16,#16,R0,R5 ;High word of input integer to R5 CMPL R5,#SET_MESSAGE_FLAGS ;Compare with set message flags code BNEQ CASE ;Branch if not MOVL R6,MSGFLGS ;Save message flags setting RETURN ;Return. Exit for (set_message_flags code) CASE: ;Save input and output string parameters MOVQ @8(AP),-(SP) ;Copy over old descriptor to stack MOVB #DSC$K_DTYPE_T,DSC$B_DTYPE(SP) ;Fill in Type MOVB #DSC$K_CLASS_S,DSC$B_CLASS(SP) ;Fill in Class MOVL SP,INSTR ;Address of new descriptor to INSTR MOVL 12(AP),OUTSTR ;Address of output string descriptor ;Case incode CASEL R5, #1, #<6-1> ;Case category item code 1$: .WORD CASSYS-1$,- ; 1 = SYSTEM stuff 2$-1$,- ; 2 = Set message_flags. Should have been taken care of above so branch to error SHODIR-1$,- ; 3 = DIRECTORY CASTRN-1$,- ; 4 = TRANSLATE EDXSRT-1$,- ; 5 = SORT EDXSPL-1$ ; 6 = SPELL 2$: PUSHL #EDX__UNKNCODE ;Unknown item code CALLS #1,EDX_SIGNAL ;Signal internal error RETURN CASSYS: ;Case 0001xxxx system code numbers CASEL R6, #1, #<11-1> ;Case specific item code 2$: .WORD LCKFIL-2$,- ; 1 = LOCK FILE UNLCKF-2$,- ; 2 = UNLOCK FILE SHOLOG-2$,- ; 3 = SHOW LOGICAL SHOSYM-2$,- ; 4 = SHOW SYMBOL SIGMSG-2$,- ; 5 = SIGNAL ERROR MESSAGE CKFILK-2$,- ; 6 = CHECK IF FILE IS LOCKED SETDEF-2$,- ; 7 = SET DEFAULT DIRECTORY SETLOG-2$,- ; 8 = DEFINE LOGICAL NAME SHOWID-2$,- ; 9 = SHOW IDENT NUMBER DELFIL-2$,- ;10 = DELETE FILE SETSYM-2$ ;11 = SET SYMBOL PUSHL #EDX__UNKNCODE ;Unknown item code CALLS #1,EDX_SIGNAL ;Signal internal error RETURN LCKFIL: CALLS #0,LOCK_FILE RETURN UNLCKF: CALLS #0,UNLOCK_FILE RETURN SHOLOG: CALLS #0,SHOW_LOGICAL RETURN SHOSYM: CALLS #0,SHOW_SYMBOL RETURN SIGMSG: CALLS #0,EDX_SIGMSG RETURN CKFILK: CALLS #0,EDX_CKFILK RETURN SETDEF: CALLS #0,EDX_SETDEF RETURN SETLOG: CALLS #0,SET_LOGICAL RETURN SHOWID: CALLS #0,SHOW_ID RETURN DELFIL: CALLS #0,DELETE_FILE RETURN SETSYM: CALLS #0,SET_SYMBOL RETURN SHODIR: ;Case 0002xxxx directory code numbers CALLS #0,EDX_DIRECTORY RETURN CASTRN: ;Case 0004xxxx translate_string code routines CASEL R6, #1, #<4-1> ;Case entry point to jump to 4$: .WORD EBCASC-4$,- ;1 = TRANSLATE EBCDIC TO ASCII ASCEBC-4$,- ;2 = TRANSLATE ASCII TO EBCDIC ENCINI-4$,- ;3 = INITIALIZE RANDOM NUMBER GENERATOR WITH PASSWORD ENCRPT-4$ ;4 = ENCRYPT/DECRYPT A STRING PUSHL #EDX__UNKNCODE ;Unknown item code CALLS #1,EDX_SIGNAL ;Signal internal error RETURN EBCASC: CALLS #0,TRA_EBC_ASC RETURN ASCEBC: CALLS #0,TRA_ASC_EBC RETURN ENCINI: CALLS #0,ENCRYPT_INIT RETURN ENCRPT: CALLS #0,ENCRYPT RETURN EDXSRT: CALLS #0,EDX_SORT RETURN EDXSPL: CALLS #0,G^EDX_SPELL RETURN ;------------------------------------------------------------------------------ .SBTTL SHOW IDENT VERSION NUMBER ;++ ; ; Functional Description: ; This routine returns the ident version number of this module ; ; Calling Sequence: ; CALLS #0,SHOW_ID ; ;-- .PSECT STATSHR RD,NOWRT,NOEXE,LONG,PIC,SHR .IDENT /6.2-297/ IDENT: .ASCII /6.2-297/ IDENTL= .-IDENT .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY SHOW_ID,^M<> PUSHAL IDENT ;address of output string PUSHL #IDENTL ;length of output string PUSHL #1 ;retcode CALLS #3,FMTOUTSTR ;format output string RET ;------------------------------------------------------------------------------ .SBTTL INITIALIZE VIRTUAL MEMORY ZONE ;++ ; ; Functional Description: ; This routine calls lib$create_vm_zone to initialize our own ; personal virtual memory zone. ; ; Calling Sequence: ; JSB INITVMZONE ; ; Registers used: ; none ;-- .PSECT DATA RD,WRT,NOEXE,LONG,PIC,NOSHR VM_ZONE:: .LONG 0 ;Our virtual memory zone id (initialize at zero) ;-- .PSECT STATSHR RD,NOWRT,NOEXE,LONG,PIC,SHR $LIBVMDEF ;Include LIB$ definitions for virtual memory VM_FLAGS: .LONG <LIB$M_VM_GET_FILL0+ - LIB$M_VM_FREE_FILL1> ;Flags to LIB$CREATE_VM_ZONE ;-- .PSECT CODE NOWRT,EXE,LONG,PIC,SHR INITVMZONE:: ;Create our own personal virtual memory zone TSTL VM_ZONE ;Our virtual memory zone id BNEQU 1$ ;Branch if zone already created PUSHAL VM_FLAGS ;flags PUSHL #0 ;algorithm-arg PUSHL #0 ;algorithm PUSHAL VM_ZONE ;zone-id CALLS #4,G^LIB$CREATE_VM_ZONE ;Create virtual memory zone 1$: RSB ;Return ;------------------------------------------------------------------------------ .SBTTL FMTOUTSTR ;++ ; ; Functional Description: ; This routine combines the return code in RETCODE with the return ; string specified by ; ; Argument inputs: ; (AP) - number of arguments (1 or 3) ; 4(AP) - value of return code ; 8(AP) - length of output string /optional May also place a string ; 12(AP) - address of output string \optional descriptor here. ; ; FMTOUTSTR STORAGE ALLOCATED ON STACK ; -----------------------------------------(descriptor for FAO output string) ; | class | dtype | string length | <00> (R11 = base address) ; ----------------------------------------- ; | buffer address | <04> ; -----------------------------------------(buffer to place FAO output string) ; | | <08> ; - - ; - - ; - - ; | | ; ----------------------------------------- ; | <08+12> ;------------------------------------------------------------------------------ .PSECT STATIC RD,NOWRT,NOEXE,LONG,PIC .ALIGN LONG CTLOUTSTR1: .ASCID /!9ZL/ ;------------------------------------------------------------------------------ .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY FMTOUTSTR,^M<R2,R3,R4,R5,R6,R7,R8,R11> ;Allocate memory on stack SUBL2 #<08 + 12>,SP ;(actually only use 9 of the 12) MOVL SP,R11 ;Store base address of memory allocated ;Initialize descriptor for FAO output string MOVW #09,DSC$W_LENGTH(R11) ;Buffer length is 9 MOVB #DSC$K_CLASS_S,DSC$B_CLASS(R11) ;Class MOVB #DSC$K_DTYPE_T,DSC$B_DTYPE(R11) ;Type MOVAL 8(R11),DSC$A_POINTER(R11) ;Buffer address ;call sys$fao with 1 argument PUSHL 4(AP) ;retcode (by value) PUSHL R11 ;outbuf (by descriptor) PUSHL R11 ;outlen (word by reference) PUSHAQ CTLOUTSTR1 ;ctrstr (by descriptor) CALLS #4,G^SYS$FAO ;format message string ;copy to outstr MOVL R11,R1 ;src-str (by descriptor) MOVL OUTSTR,R0 ;dst-str (by descriptor) JSB G^STR$COPY_DX_R8 ;Copy to OUTSTR CMPL (AP),#1 ;See if there was only one argument BEQL 10$ ;Branch if so ;Reuse string descriptor MOVW 8(AP),DSC$W_LENGTH(R11) ;Buffer length MOVL 12(AP),DSC$A_POINTER(R11) ;Buffer address PUSHL R11 ;src-str PUSHL OUTSTR ;dst-str CALLS #2,G^STR$APPEND ;append retstr to end of retcode 10$: RET ;------------------------------------------------------------------------------ .SBTTL EDX_SIGNAL ;++ ; ; Functional Description: ; This routine prints message text to the message buffer. The routine ; input is modeled after LIB$SIGNAL. (See description of LIB$SIGNAL) ; ; Calling Sequence: ; CALL EDX_SIGNAL (condition-value1 ; [,number1] ; [,FAO-arg1 ; . ; FAO-argn1] ; [,condition-value2] ; [,number2] ; [,FAO-arg2 ; . ; FAO-argn2] ; etc. ; ; Argument inputs: ; (AP) - number of arguments (value) ; 4(AP) - condition-value1 (value) ; 8(AP) - number1 (value) ; 12(AP) - FAO-arg1 (unspecified. Values sent directly to FAO) ; etc. ; ; Outline: ; 1. Allocate memory on stack ; 2. Check severity of message to signal. If FATAL then use full ; message format (facility, identification, severity, text). Otherwise ; obtain current TPU message flags by calling ourselves using TPU$EXECUTE_COMMAND. ; The TPU command executed is: ; EDTN$X_DUMMY := CALL_USER( ^x00020000 + GET_INFO(SYSTEM,"message_flags"), "") ) ; which parses to: ; EDTN$X_DUMMY := CALL_USER( ^x0002000F, "") ; where 'F' is the current setting of the message flags (0-F hex). ; This value gets stored in MSGFLGS. ; 3. Call sys$getmsg to get message text ; 4. Call sys$fao to process message text ; 5. Call tpu$message to write message text to tpu message_buffer. ; ; EDX_SIGNAL STORAGE ALLOCATED ON STACK ; -----------------------------------------(descriptor for FAO output string) ; | class | dtype | string length | <^x00> (R2 = base address) ; ----------------------------------------- ; | buffer address | <^x04> ; -----------------------------------------(buffer to place FAO output string) ; | | <^x08> ; - - ; - - ; - - ; | | ; -----------------------------------------(descriptor for message string) ; | class | dtype | string length | <^x08+BUFLEN> ; ----------------------------------------- ; | buffer address | <^x0C+BUFLEN> ; -----------------------------------------(buffer to place message string) ; | | <^x10+BUFLEN> ; - - ; - - ; - - ; | | ; -----------------------------------------(original stack pointer) ; | <^x10+2*BUFLEN> ; ;------------------------------------------------------------------------------ .PSECT STATIC RD,NOWRT,NOEXE,LONG,PIC .ALIGN LONG BELL:: .ASCID <^x07> ;String containing bell character .ALIGN LONG MSGFLGCMD: .ASCID /EDTN$X_DUMMY:=CALL_USER(131072+GET_INFO(SYSTEM,'MESSAGE_FLAGS'),"")/ ;------------------------------------------------------------------------------ .PSECT DATA RD,WRT,NOEXE,LONG,PIC,NOSHR .ALIGN LONG MSGFLGS: .LONG ^B1111 ;Current TPU message_flags ;------------------------------------------------------------------------------ .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY EDX_SIGNAL,^M<R2,R3> ;Allocate memory on stack SUBL2 #<^x10 + <2*BUFLEN>>,SP ;Move stack pointer over memory we claim MOVL SP,R2 ;Store base address. We'll use this memory for the message strings ;Initialize counter in R3 to count call arguments used CLRL R3 ;Check severity of primary message. Ring bell if not good. BLBS 4(AP),1$ ;Branch if success message BITL #^B0011,4(AP) ;Test for warning BEQL 1$ ;No bell if warning PUSHAL BELL ;Ring terminal bell CALLS #1,G^LIB$PUT_OUTPUT ;If message is fatal, use full message flags BITL 4(AP),#STS$K_SEVERE ;Compare with fatal status BEQL 1$ ;Branch if not fatal MOVZBL #^x0F,MSGFLGS ;Use full message format BRB 2$ ;Otherwise if non-fatal status then get current value of message flags 1$: PUSHAQ MSGFLGCMD CALLS #1,G^TPU$EXECUTE_COMMAND ;Initialize descriptor for message string 2$: MOVAL <^x10+BUFLEN>(R2),<^x0C+BUFLEN>(R2) ;Buffer address MOVB #DSC$K_CLASS_S,<^x0B+BUFLEN>(R2) ;Class MOVB #DSC$K_DTYPE_T,<^x0A+BUFLEN>(R2) ;Type ;Initialize descriptor for FAO output string MOVAL <^x08>(R2),DSC$A_POINTER(R2) ;Buffer address MOVB #DSC$K_CLASS_S,DSC$B_CLASS(R2) ;Class MOVB #DSC$K_DTYPE_T,DSC$B_DTYPE(R2) ;Type ;BEGIN MAIN LOOP ;Initialize buffer length in message string descriptor and FAO output string descriptor 3$: MOVW #BUFLEN,<^X08+BUFLEN>(R2) ;Buffer length in message string descriptor MOVW #BUFLEN,(R2) ;Buffer length in FAO output string descriptor ;Increment R3 count of arguments used (point to next message-id) INCL R3 ;Call sys$getmsg PUSHL #0 ;outadr PUSHL MSGFLGS ;flags (by value) PUSHAQ <^x08+BUFLEN>(R2) ;bufadr (address of descriptor) PUSHAW <^x08+BUFLEN>(R2) ;msglen (by reference) PUSHL (AP)[R3] ;msgid (by value) CALLS #5,G^SYS$GETMSG ;get message text ;Check for FAO arguments INCL R3 ;Number of FAO arguments INCL R3 ;FAO argument #1 SUBL3 R3,(AP),R1 ;Number of arguments used - number of arguments given BLSS 4$ ;Branch if no arguments left to use ;call sys$fao PUSHAL (AP)[R3] ;prmlst PUSHL R2 ;outbuf PUSHL R2 ;outlen PUSHAQ <^x08+BUFLEN>(R2) ;ctrstr CALLS #4,G^SYS$FAOL ;format message string ;call tpu$message PUSHL R2 ;Address of output descriptor CALLS #1,G^TPU$MESSAGE ;Output the string ;See if there's another message to do DECL R3 ;(AP)[R3] is FAO argument count ADDL2 (AP)[R3],R3 ;Increment R3 number of FAO arguments CMPL R3,(AP) ;See if call specified more arguments BLSS 3$ ;If so then loop RET ;Else return. All done. ;Print out last (or only) message 4$: PUSHAQ <^x08+BUFLEN>(R2) ;Address of output descriptor CALLS #1,G^TPU$MESSAGE ;Output the message RET ;and return ;------------------------------------------------------------------------------ .SBTTL EDX_SIGMSG ;++ ; ; Functional Description: ; Prints error message associated with error number in string INSTR ; only if error status was warning. TPU prints errors but trapped ; warnings are not printed, so we call this routine to print the ; error if it happens to be warning status. ; ; Calling Sequence: ; CALLS #0,EDX_SIGMSG ; ; Argument inputs: ; INSTR = address of string descriptor pointing ; to string containing error number. ; ; Outputs: ; Error message is printed to TPU message_buffer ; if error status was warning. ; ; Outline: ; 1. String containing error code is translated to numeric value ; 2. EDX_SIGNAL is called to print error message ; ;-- .ENTRY EDX_SIGMSG,^M<R2,R3,R5> ;Convert string containing integer to integer by using LIB$CVT_DTB PUSHL #0 ;Make memory location for result on stack MOVL SP,R2 ;Address of result PUSHL R2 ;Address of result MOVL INSTR,R3 ;Address of input string descriptor PUSHL 4(R3) ;Address of string MOVZWL (R3),R5 ;Length of string PUSHL R5 ;Length of string (by value) CALLS #3,G^LIB$CVT_DTB ;Convert string to integer BITL (R2),#STS$M_SEVERITY ;Test for warning status BNEQ 1$ ;Branch if not warning CALLS #1,EDX_SIGNAL ;Signal resulting error number 1$: RET ;------------------------------------------------------------------------------ .SBTTL CONDITION HANDLER ;++ ; ; Functional Description: ; This routine handles unexpected errors that are signaled. ; The error is printed to the TPU message_buffer. ; If the error is severe, an attempt is made to return to TPU, ; otherwise the error is non-fatal and an attempt is made to continue. ; ; NEW - A signal of any type including Informational (-I-) is not ; resignaled because the TPU CALL_USER routine establishes it's own ; condition handler that will be called next if our handler does not ; handle the condition, and the TPU handler calls LIB$SIG_TO_RET if ; the signaled condition does not have a facility value of TPU. ; ; Therefore we never return with SS$_RESIGNAL ; ; Inputs: ; CHF$L_SIGARGLST(AP) - Address of sigargs array ;-- .PSECT DATA RD,WRT,NOEXE,LONG,PIC,NOSHR .ALIGN LONG ;The following errors take the PC and PSL as FAO arguments. The rest don't. ERRPCPSL: .LONG SS$_ACCVIO .LONG SS$_ARTRES .LONG SS$_INTOVF .LONG SS$_FLTDIV .LONG SS$_FLTUND .LONG SS$_DECOVF .LONG SS$_SUBRNG .LONG SS$_ASTFLT .LONG SS$_BREAK .LONG SS$_CMODSUPR .LONG SS$_CMODUSER .LONG SS$_DEBUG .LONG SS$_OPCCUS .LONG SS$_OPCDEC .LONG SS$_PAGRDERR .LONG SS$_RADRMOD .LONG SS$_ROPRAND .LONG SS$_SSFAIL .LONG SS$_TBIT NUMPCPSL=19 ;number in above list .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY HANDLER ^M<R2,R3,R4> MOVL CHF$L_SIGARGLST(AP),R4 ;Get address of signal args MOVL CHF$L_SIG_NAME(R4),R2 ;Get condition code CMPL #SS$_UNWIND,R2 ;Check for unwind operation BNEQ 20$ ;Branch if not RET ;Return. Unwinding ;Print out all messages, including successfull ones. 20$: PUSHL R2 MOVL SP,R2 ;R2 is now address of condition value MOVAL ERRPCPSL,R0 ;set up and call LIB$MATCH_COND MOVL #NUMPCPSL,R1 DECL R1 ;convert to offset 21$: PUSHAL (R0)[R1] ;push all errors which use PC and PSL SOBGEQ R1,21$ PUSHL R2 ;address of condition value MOVL (R2),R2 ;R2 = condition value again ADDL3 #1,#NUMPCPSL,R0 ;total number of arugments CALLS R0,G^LIB$MATCH_COND ;returns R0 = 0 if not require PC and PSL MOVL CHF$L_SIG_ARGS(R4),R1 ;number of FAO arguments for error DECL R1 ;remove one for condition name in signal array TSTL R0 BNEQ 31$ SUBL2 #2,R1 ;decrement number by 2 if not require PC and PSL 31$: MOVL R1,R3 MOVAL CHF$L_SIG_ARG1(R4),R0 BRB 33$ 32$: PUSHL (R0)[R1] ;push arguments on stack 33$: SOBGEQ R1,32$ PUSHL R3 ;number of arguments for error PUSHL R2 ;Push error code on stack BITL #STS$K_SEVERE,R2 ;Check for fatal status BNEQ 40$ ;Branch if fatal INCL R3 CALLS R3,EDX_SIGNAL ;Print error to TPU message_buffer MOVL #SS$_CONTINUE,R0 ;Signal to continue RET ;Return from exception ; Handle unexpected fatal errors 40$: PUSHL #0 ;Zero FAO arguments for EDX__UNEXPERR PUSHL #EDX__UNEXPERR ;Error message ADDL3 #3,R3,R0 CALLS R0,EDX_SIGNAL ;Print the error message ;Unwind stack and return to TPU CALLS #0,G^SYS$UNWIND ;unwind stack RET ;============================================================================== .SUBTITLE EDX_DIRECTORY ;++ ; ; Functional Description: ; Displays a directory listing ; ; Calling Sequence: ; CALLS #0,EDX_DIRECTORY ; ; Argument inputs: ; R6 = Code describing where to reenter (low word of INCODE) ; INSTR = Address of descriptor of directory command ; The directory command is of the form: ; DIRECTORY [/SIZE] [/DATE] [dir-spec] ; ; Outputs: ; OUTSTR = Line to place in DIR_BUFFER ; RETCODE = Code to use for consecutive calls ; (note: OUTSTR and RETCODE are placed together in the returned string ; by FMTOUTSTR routine. RETCODE is stored in first 9 characters of ; the returned output string.) ; ; Comments: ; For regular directory listing, filenames are placed 4 across ; staring at column offsets 0,20,40,60. ; ; For /SIZE or /DATE qualifiers, filenames are placed at column offset 0. ; Then if col is greater than 18 line is written and new line started ; Error starts at column offset 19 if there is one ; else /SIZE starts at offset 19 if specified ; and /DATE starts at offset 29 if specified ; ; COL is used as both a length indicator and a column offset indicator. ; The value of COL is the number of characters in OUTLINE. When the ; value of COL is added to the base address of OUTLINE, the result is ; the address to start adding text to when appending text out OUTLINE. ; ; Outline: ; 1. Entry code is cased for consecutive reentries ; 2. On initial entry ; A. a. Dirflgs is initialized ; b. The EDX directory command is parsed for /SIZE, /DATE, and dir-spec. ; B. Memory is allocated for DIRBLK ; a. Create VM_ZONE if we haven't already. ; b. If memory base address DIRBLKBSE isn't zero attempt to ; deallocate memory which may have been allocated by a ; previous call and then aborted by a user's CTRL-C input. ; c. Allocate new memory block for DIRBLK. ; C. New DIRBLK is initialized ; a. FAB block initialized ; b. NAM block initialized ; c. XABFHC block initialized ; d. XABDAT block initialized ; e. Variables are initialized ; D. Dir-spec placed into FAB ; E. Set DIRFLGS according to /SIZE and /DATE qualifiers ; F. $PARSE FAB to prepare for wildcard operations ; 3. $SEARCH FAB for next filename ; 4. If 'No more files' or 'File Not Found' or other error, exit with code ; 5. Print new directory heading if needed ; A. If this is the first call, return first with the expanded ; string for the window status line. ; B. Print directory heading. ; 6. Add new file to outline. ; A. Move COL offset pointer into outline to next tab stop (0,20,40,60) ; Print outline if line full. ; B. Add filename to outline ; 7. Check DIRFLGS for qualifiers like /SIZE and /DATE ; A. If no qualifiers present then goto step 3. ; B. Print outline if filename too long ; C. Get file attributes ; D. Add size info if requested ; E. Add date info if requested ; F. Print outine ; G. Goto step 3. ; 8. Repeat until exit by step 4. ; ; Description: ; The TPU editor calls us with an initial code of START. We return to ; the TPU editor with an output string and a code telling the editor what ; to do with the output string. Usually the TPU editor is to print the ; output string to the dir_buffer, occasionally it must add a blank line ; or two. It then calls us back passing to us the value of code we gave ; it. The value of code tells us where to jump back to. The TPU editor ; continues to call us until we pass it the NMF_ERR code. ; ; Register usage: ; R9 = used as base address of DIRBLK (which is also the address of ; the FAB block. This number is permanently stored in DIRBLKBSE) ; R10= used as base address of NAM block, XABFHC block, and XABDAT block. ; ; Memory Map: ; ; DIRBLK BLOCK ; -----------------------------------------(start of FAB block) ; | IFI | BLN | BID | 00 (base address is DIRBLKBSE also R9) ; ----------------------------------------- ; | FOP | 04 ; ----------------------------------------- ; | STS | 08 ; ----------------------------------------- ; | STV | 0C ; ----------------------------------------- ; | ALQ | 10 ; ----------------------------------------- ; | SHR | FAC | DEQ | 14 ; ----------------------------------------- ; | CTX | 18 ; ----------------------------------------- ; | RFM | RAT | ORG | RTV | 1C ; ----------------------------------------- ; | | |FACILITY | JOURNAL | 20 ; ----------------------------------------- ; | XAB | 24 ; ----------------------------------------- ; | NAM | 28 ; ----------------------------------------- ; | FNA | 2C ; ----------------------------------------- ; | DNA | 30 ; ----------------------------------------- ; | MRS | DNS | FNS | 34 ; ----------------------------------------- ; | MRN | 38 ; ----------------------------------------- ; | FSZ | BKS | BLS | 3C ; ----------------------------------------- ; | DEV | 40 ; ----------------------------------------- ; | SDC | 44 ; ----------------------------------------- ; | RCF | ACMODES | GBC | 48 ; ----------------------------------------- ; | | | | | 4C ; ----------------------------------------- (start of NAM block) ; | RSL | RSS | BLN | BID | 00 + FAB$C_BLN (base address is R10) ; ----------------------------------------- ; | RSA | 04 ; ----------------------------------------- ; | ESL | ESS | RFS | NOP | 08 ; ----------------------------------------- ; | ESA | 0C ; ----------------------------------------- ; | RLF | 10 ; ----------------------------------------- ; | | | | | 14 ; ----------------------------------------- ; | | | | | 18 ; ----------------------------------------- ; | | | | | 1C ; ----------------------------------------- ; | | | | | 20 ; ----------------------------------------- ; | FID_SEQ | FID_NUM | 24 ; ----------------------------------------- ; | DID | FID_NBX | FID_RVN | 28 ; ----------------------------------------- ; | DID_NMX | DID_RVN | DID_SEQ | 2C ; ----------------------------------------- ; | WCC | 30 ; ----------------------------------------- ; | FNB | 34 ; ----------------------------------------- ; | NAME | DIR | DEV | NODE | 38 ; ----------------------------------------- ; | | | VER | TYPE | 3C ; ----------------------------------------- ; | NODE | 40 ; ----------------------------------------- ; | DEV | 44 ; ----------------------------------------- ; | DIR | 48 ; ----------------------------------------- ; | NAME | 4C ; ----------------------------------------- ; | TYPE | 50 ; ----------------------------------------- ; | VER | 54 ; ----------------------------------------- ; | | | | | 58 ; ----------------------------------------- ; | | | | | 5C ; -----------------------------------------(Input directory specification string) ; | INPUT FILE SPEC | FAB$C_BLN+NAM$C_BLN ; | . | (=INPFS) ; | . | ; | | ; -----------------------------------------(Result file name string) ; | RESULTANT FILE NAME STRING | FAB$C_BLN+NAM$C_BLN+<1*BUFLEN> ; | . | ; | . | ; | | ; -----------------------------------------(expanded file name string returned) ; | EXPANDED FILE NAME STRING | FAB$C_BLN+NAM$C_BLN+<2*BUFLEN> ; | . | (=EFNS) ; | . | ; | | ; -----------------------------------------(root directory) ; | ROOT | FAB$C_BLN+NAM$C_BLN+<3*BUFLEN> ; | . | (=ROOT) ; | . | ; | | ; -----------------------------------------(line to print to screen) ; | OUTLINE | FAB$C_BLN+NAM$C_BLN+<4*BUFLEN> ; | . | (=OUTLINE) ; | . | ; | | ; -----------------------------------------(current column offset into OUTLINE. Current root directory length. Directory flags /SIZE=1,/DATE=2. First time root has been printed (True/False).) ; | FRSTIME | DIRFLGS | ROOTLEN | COL | FAB$C_BLN+NAM$C_BLN+<4*BUFLEN>+OUTLNLEN ; -----------------------------------------(XABFHC block) ; | | | BLN | BID | 00 + FAB$C_BLN+NAM$C_BLN+<4*BUFLEN>+OUTLNLEN+^x04 ; ----------------------------------------- ; | NXT | 04 ; ----------------------------------------- ; | LRL | ATR | RFO | 08 ; ----------------------------------------- ; | HBK | 0C ; ----------------------------------------- ; | EBK | 10 ; ----------------------------------------- ; | HSZ | BKZ | FFB | 14 ; ----------------------------------------- ; | DXQ | MRZ | 18 ; ----------------------------------------- ; | | | GBC | 1C ; ----------------------------------------- ; | | | | | 20 ; ----------------------------------------- ; | VERLIMIT | | | 24 ; ----------------------------------------- ; | SBN | 28 ; -----------------------------------------(XABDAT block) ; | | | BLN | COD | 00 + FAB$C_BLN+NAM$C_BLN+<4*BUFLEN>+OUTLNLEN+^x04+XAB$C_FHCLEN ; ----------------------------------------- ; | NXT | 04 ; ----------------------------------------- ; | | | | | 08 ; ----------------------------------------- ; | | | | | 0C ; ----------------------------------------- ; | | | | | 10 ; ----------------------------------------- ; | CDT | 14 ; - - ; | | 18 ; ----------------------------------------- ; | EDT | 1C ; - - ; | | 20 ; ----------------------------------------- ; | BDT | 24 ; - - ; | | 28 ; ----------------------------------------- ; | FAB$C_BLN+NAM$C_BLN+<4*BUFLEN>+OUTLNLEN+^x04+XAB$C_FHCLEN+XAB$C_DATLEN ; ;------------------------------------------------------------------------------ .PSECT STATSHR RD,NOWRT,NOEXE,LONG,PIC,SHR .EXTERNAL EDX_COMMANDS ;dir flags GET_SIZE = 1 GET_DATE = 2 ;column offset positions & constants ;....v....1....v....2....v....3....v....4....v....5....v....6....v....7....v.... ;FILENAMEABC.EFG;21 00000000 25-JUL-1988 17:14 DATCOL = 29 SIZCOL = 19 SIZLEN = 8 DATLEN = 17 OUTLNLEN=132 ;incodes SRCHLP_CODE = 2 ;TPU prints outline and calls again PROOT_CODE = 3 ;TPU prints outline followed by two blank lines and calls us again NXTTAB_CODE = 4 ;TPU prints outline followed by one blank line and calls us again ADFILE_CODE = 5 ;TPU prints outline and calls us again GETATR_CODE = 6 ;TPU prints outline and calls us again RMS_ERR = 7 ;We print error message. TPU exits. FNF_ERR = 8 ;TPU prints 'no files found' and exits NMF_ERR = 9 ;TPU prints outline and exits ;offsets INPFS = FAB$C_BLN+NAM$C_BLN RSFN = FAB$C_BLN+NAM$C_BLN+<1*BUFLEN> EFNS = FAB$C_BLN+NAM$C_BLN+<2*BUFLEN> ROOT = FAB$C_BLN+NAM$C_BLN+<3*BUFLEN> OUTLINE = FAB$C_BLN+NAM$C_BLN+<4*BUFLEN> COL = FAB$C_BLN+NAM$C_BLN+<4*BUFLEN>+OUTLNLEN ROOTLEN = FAB$C_BLN+NAM$C_BLN+<4*BUFLEN>+OUTLNLEN+^x01 DIRFLGS = FAB$C_BLN+NAM$C_BLN+<4*BUFLEN>+OUTLNLEN+^x02 FIRST_TIME = FAB$C_BLN+NAM$C_BLN+<4*BUFLEN>+OUTLNLEN+^x03 XABFHC = FAB$C_BLN+NAM$C_BLN+<4*BUFLEN>+OUTLNLEN+^x04 XABDAT = FAB$C_BLN+NAM$C_BLN+<4*BUFLEN>+OUTLNLEN+^x04+XAB$C_FHCLEN DIRBLKLEN = FAB$C_BLN+NAM$C_BLN+<4*BUFLEN>+OUTLNLEN+^x04+XAB$C_FHCLEN+XAB$C_DATLEN .ALIGN LONG DIRH: .ASCII /Directory / ;Directory header DIRHLEN=.-DIRH ;Length of directory header .ALIGN LONG DEFAULT: .ASCII /*.*;*/ DEFLEN=.-DEFAULT .PSECT STATIC RD,NOWRT,NOEXE,LONG,PIC .ALIGN LONG SIZE: .ASCID /SIZE/ ;/SIZE parameter .ALIGN LONG DATE: .ASCID /DATE/ ;/DATE parameter .ALIGN LONG DIRSPEC: .ASCID /DIRSPEC/ ;dir-spec parameter .ALIGN LONG FAOSIZE: .ASCID /!8UL/ ;Control string for adding size to output (SIZLEN=8) ;------------------------------------------------------------------------------ .PSECT DATA RD,WRT,NOEXE,LONG,PIC,NOSHR .ALIGN LONG DIRBLKBSE: .LONG 0 ;Base address of dirblk ;------------------------------------------------------------------------------ .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY EDX_DIRECTORY,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10> ;1. Entry code is cased for consecutive reentries ;R6 = Entry code passed by caller ;CASE ENTRY CODE MOVL DIRBLKBSE,R9 ;Set R9 as base address of DIRBLK CASEL R6, #1, #5 ;Case entry point to jump to 1$: .WORD DSTRT-1$,- ; 1 = first call SRCHLP-1$,- ; 2 = go to SRCHLP PROOT-1$,- ; 3 = go to PROOT NXTTAB-1$,- ; 4 = go to NXTTAB ADFILE-1$,- ; 5 = go to ADFILE GETATR-1$ ; 6 = go to GETATR MOVL #EDX__UNKNCODE,R0 ;Put error status in R0 BSBW ERR ;Signal error RET ;and return with error status in R0 ;2. On initial entry ; A. a. Dirflgs is initialized DSTRT: PUSHL #0 ;Initialize dirflgs at zero PUSHL SP ;Address of dirflgs CALLS #1,GETDEFDIRFLGS ;Get default qualifiers ; A. b. The directory command is parsed for /SIZE, /DATE, and dir-spec. ;PARSE DIRECTORY COMMAND STRING USING CLI$DCL_PARSE PUSHAL EDX_COMMANDS ;Address of command table for parse PUSHL INSTR ;Address of input string descriptor CALLS #2,G^CLI$DCL_PARSE ;Parse input string BLBS R0,CHKVM ;Branch on success RET ;else return. CLI$DCL_PARSE signaled error and our condition handler printed the error. ; B. Memory is allocated for DIRBLK ; a. Create VM_ZONE if we haven't already. ;CHECK VIRTUAL MEMORY ZONE CHKVM: BSBW INITVMZONE ;Initialize our virtual memory zone ; b. If memory base address DIRBLKBSE isn't zero attempt to ; deallocate memory which may have been allocated by a ; previous call and then aborted by a user's CTRL-C input. ;TEST FOR MEMORY BLOCK ALREADY IN USE TSTVM: TSTL DIRBLKBSE ;Make sure memory not already allocated BEQLU ALOCVM ;Branch if memory not already allocated ;ATTEMPT TO DEALLOCATE PREVIOUSLY USED BLOCK MOVL #DIRBLKLEN,-(SP) ;Length of memory block to deallocate MOVL SP,R0 ;Address of above (by reference) PUSHAL VM_ZONE ;Our virtual memory zone id PUSHAL DIRBLKBSE ;Address of return address of memory block allocated PUSHL R0 ;Address containing length of memory to allocate CALLS #3,G^LIB$FREE_VM ;Attempt to deallocate memory previously in use CLRL (SP)+ ;Restore stack pointer ; c. Allocate new memory block for DIRBLK. ;ALLOCATE BLOCK OF MEMORY ALOCVM: MOVL #DIRBLKLEN,-(SP) ;Length of memory block to allocate MOVL SP,R0 ;Address of above (by reference) PUSHAL VM_ZONE ;Our virtual memory zone id PUSHAL DIRBLKBSE ;Address to place return address of memory block allocated PUSHL R0 ;Address containing length of memory to allocate (LNKFABLEN by reference) CALLS #3,G^LIB$GET_VM ;Allocate memory for new block in linked list CLRL (SP)+ ;Restore stack pointer BLBS R0,INIFAB ;Continue if successful BSBW ERR ;Else error signal message RET ;and return ; C. New DIRBLK is initialized ; a. FAB block initialized ;INITIALIZE FAB INIFAB: MOVL DIRBLKBSE,R9 ;Set R9 as base address of DIRBLK MOVB #FAB$C_BID,FAB$B_BID(R9) ;FAB block ID # MOVB #FAB$C_BLN,FAB$B_BLN(R9) ;FAB block length MOVAB FAB$C_BLN(R9),FAB$L_NAM(R9) ;NAM block address MOVAB XABFHC(R9),FAB$L_XAB(R9) ;XAB block address (XABFHC) MOVL #FAB$M_NAM,FAB$L_FOP(R9) ;FAB Options = use NAM block MOVAL DEFAULT,FAB$L_DNA(R9) ;Default file name of *.*;* MOVB #DEFLEN,FAB$B_DNS(R9) ;Default file name length MOVAL INPFS(R9),FAB$L_FNA(R9) ;Address of input string containing dir-spec BISB2 #FAB$M_GET,FAB$B_FAC(R9) ;File Access options = GET BISB2 #<FAB$M_SHRGET+ - ;Allow read/write sharing FAB$M_SHRPUT+ - ; in case we have to open the FAB$M_SHRUPD+ - ; file to get the file attributes FAB$M_SHRDEL>,FAB$B_SHR(R9) ; ; b. NAM block initialized ;INITIALIZE NAM BLOCK ADDL3 #FAB$C_BLN,R9,R10 ;R10 = Address of NAM block MOVB #NAM$C_BID,NAM$B_BID(R10) ;NAM block ID # MOVB #NAM$C_BLN,NAM$B_BLN(R10) ;NAM block length MOVB #NAM$C_MAXRSS,NAM$B_RSS(R10) ;Resultant file name string size ADDL3 #RSFN,R9,NAM$L_RSA(R10) ;Resultant file name string address MOVB #NAM$C_MAXRSS,NAM$B_ESS(R10) ;Expanded file name string size ADDL3 #EFNS,R9,NAM$L_ESA(R10) ;Expanded file name string address ; c. XABFHC block initialized ;INITIALIZE XABFHC BLOCK ADDL3 #XABFHC,R9,R10 ;R10 = Base address of XABFHC MOVB #XAB$C_FHC,XAB$B_COD(R10) ;XABFHC ID code MOVB #XAB$C_FHCLEN,XAB$B_BLN(R10) ;XABFHC block length MOVAB XABDAT(R9),XAB$L_NXT(R10) ;Address of next XAB (XABDAT) ; d. XABDAT block initialized ;INITIALIZE XABDAT ADDL3 #XABDAT,R9,R10 ;R10 = Base address of XABDAT MOVB #XAB$C_DAT,XAB$B_COD(R10) ;XABDAT ID code MOVB #XAB$C_DATLEN,XAB$B_BLN(R10) ;XABDAT block length ; e. Variables are initialized ;INITIALIZE VARIABLES MOVC5 #0,(SP),#SPACE,#OUTLNLEN,OUTLINE(R9) ;Clear outline MOVB #1,FIRST_TIME(R9) ;Set first time to true CLRB COL(R9) ;Set column offset := 0 ; D. Dir-spec placed into FAB ;GET DIR-SPEC INTO FAB BLOCK BY CALLING CLI$GET_VALUE ;R2 becomes address of temporary descriptor built on stack for dir-spec string ;R3 becomes address of resulting dir-spec string length PUSHL #0 ;Build temp descriptor on stack PUSHL #0 ;for dir-spec string MOVL SP,R2 ;Save address of descriptor in R2 MOVW #NAM$C_MAXRSS, DSC$W_LENGTH(R2) ;Length of dirspec string buffer MOVB #DSC$K_DTYPE_T,DSC$B_DTYPE(R2) ;Descriptor type MOVB #DSC$K_CLASS_S,DSC$B_CLASS(R2) ;Descriptor Class ADDL3 #INPFS,R9, DSC$A_POINTER(R2);Address of dirspec string buffer PUSHL #0 ;Place for return length MOVL SP,R3 ;Address of above (by reference) PUSHL R3 ;retlength PUSHL R2 ;retdesc PUSHAL DIRSPEC ;Get dir-spec CALLS #3,G^CLI$GET_VALUE ;Get dir-spec MOVB (R3),FAB$B_FNS(R9) ;Length of string containing file name ADDL2 #12,SP ;Restore stack pointer ; E. Set DIRFLGS according to /SIZE and /DATE qualifiers ;Check for /SIZE POPL R0 ;Default dirflgs stored on stack MOVB R0,DIRFLGS(R9) ;Set dirflgs PUSHAL SIZE ;Check for /SIZE present in command string CALLS #1,G^CLI$PRESENT ; CMPL R0,#CLI$_PRESENT BNEQ 31$ BISB2 #GET_SIZE,DIRFLGS(R9) BRB 32$ 31$: CMPL R0,#CLI$_NEGATED BNEQ 32$ BICB2 #GET_SIZE,DIRFLGS(R9) ;Check for /DATE 32$: PUSHAL DATE ;Check for /DATE present in command string CALLS #1,G^CLI$PRESENT ; CMPL R0,#CLI$_PRESENT BNEQ 33$ BISB2 #GET_DATE,DIRFLGS(R9) BRB PARSE 33$: CMPL R0,#CLI$_NEGATED BNEQ PARSE BICB2 #GET_DATE,DIRFLGS(R9) ; F. $PARSE FAB to prepare for wildcard operations ;PARSE THE DIR-SPEC PARSE: PUSHL R9 ;Address of FAB block CALLS #1,G^SYS$PARSE ;Parse it once to set up wildcard searching BLBS R0,SRCHLP ;Branch if ok BSBW ERR ;else signal error (could be Directory Not Found, Invalid Device Name, etc) BRW CLEANUP ;and cleanup ;3. $SEARCH FAB for next filename ;4. If 'No more files' or 'File Not Found' or other error, exit with code ;SEARCH FOR A FILENAME SRCHLP: PUSHL R9 ;Address of FAB CALLS #1,G^SYS$SEARCH ;Find next file CMPL R0,#RMS$_NORMAL ;Check for normal status BEQL CKRT ;continue if normal CMPL R0,#RMS$_FNF ;Check for 'File Not Found' status BNEQ 5$ ; branch if not MOVL #FNF_ERR,R1 ; else set return status code to 'File Not Found' BRW CLEANUP ; and go to cleanup 5$: CMPL R0,#RMS$_NMF ;Check for 'No More Files' status BNEQ 6$ ; branch if not MOVL #NMF_ERR,R1 ; else set return status code to 'No More Files' BRW CLEANUP ; and go to cleanup 6$: BSBW ERR ;Wasn't any of the expected errors BRW CLEANUP ;so signal error and go to cleanup ;5. Print new directory heading if needed ;WE HAVE A NEW FILENAME TO PROCESS ;PRINT OUT NEW DIRECTORY HEADING IF NEEDED CKRT: TSTB FIRST_TIME(R9) ;See if first time BEQL 1$ ;Branch if not ADDL3 #FAB$C_BLN,R9,R10 ;R10 = Address of NAM block MOVZBL NAM$B_ESL(R10),R0 ;R0 = Length of expanded directory specification MOVC3 R0,@NAM$L_ESA(R10),OUTLINE(R9) ;Move expanded directory specification to outline MOVB NAM$B_ESL(R10),COL(R9) ;Move length of directory specification to col MOVL #PROOT_CODE,R1 ;Set window status line BRW PRINT ;call us again jumping to PROOT 1$: MOVZBL ROOTLEN(R9),R0 ;Move length of root to R0 (byte) CMPC3 R0,ROOT(R9),RSFN(R9) ;Compare old root with new BEQLU NXTTAB ;Branch if root is still same MOVL #PROOT_CODE,R1 ;Print out old outline followed by two blank lines and have TPU BRW PRINT ;call us again jumping to PROOT ;PRINT NEW DIRECTORY HEADING ;FILENAME IS OF FORM NODE::DEV:[DIR]NAME.TYPE;VER PROOT: ADDL3 #FAB$C_BLN,R9,R10 ;R10 = base address of NAM block CLRB FIRST_TIME(R9) ;Set first_time to False CLRL R6 ADDB3 NAM$B_NODE(R10),- ;Calculate length of node::dev[dir] NAM$B_DEV(R10),R6 ;Add node length + device length ADDB2 NAM$B_DIR(R10),R6 ;Add dir length MOVB R6,ROOTLEN(R9) ;Place new length in rootlen MOVC3 R6,RSFN(R9),ROOT(R9) ;Place new "disk:[dir]" to root buffer MOVC3 #DIRHLEN,DIRH,OUTLINE(R9) ;Move "Directory " to outline MOVC3 R6,RSFN(R9),- <OUTLINE+DIRHLEN>(R9) ;Add new "disk:[dir]" to outline making string "Directory DISK:[DIRECTORY]" form ADDB3 #DIRHLEN,R6,COL(R9) ;Length of OUTLINE MOVL #NXTTAB_CODE,R1 ;Print out directory root followed by one blank line and have TPU BRW PRINT ;Print new directory heading ;6. Add new file to outline. ; A. Move COL offset pointer into outline to next tab stop (0,20,40,60) ; Print outline if line full. ;MOVE TO NEXT TAB STOP (0,20,40,60) NXTTAB: MOVZBL COL(R9),R0 ;R0 = COL BEQL ADFILE ;If COL = 0 then go add next filename CMPL R0,#20 ;If COL >= 20 BGEQ 2$ ;then branch MOVZBL #20,R0 ;else COL := 20 BRB 4$ ;and goto check file length 2$: CMPL R0,#40 ;If COL >= 40 BGEQ 3$ ; then branch MOVZBL #40,R0 ; else COL := 40 BRB 4$ ; and goto check file length 3$: CMPL R0,#60 ;If COL >= 60 BGEQ 5$ ; then branch and print line MOVZBL #60,R0 ; else COL := 60 4$: ADDL3 #FAB$C_BLN,R9,R10 ;Calculate length of filename to add. R10 = Address of NAM block CLRL R6 ;Calculate length of file name to add ADDB3 NAM$B_NAME(R10),- ;Calculate length of name.type;ver place in R6 NAM$B_TYPE(R10),R6 ;Add length of name + type ADDB2 NAM$B_VER(R10),R6 ;Add length of version ADDL2 R0,R6 ;Add length of filename CMPL R6,#80 ;Compare with screen width BGEQ 5$ ;Add file if enough room left on line MOVB R0,COL(R9) ;Set col at next tab stop BRB ADFILE ;Branch to adfile 5$: MOVL #ADFILE_CODE,R1 ;Not enough room for next filename. Print out the line BRW PRINT ; B. Add filename to outline ;ADD NEW FILENAME TO OUTLINE ADFILE: ADDL3 #FAB$C_BLN,R9,R10 ;R9 = Address of NAM block CLRL R6 ADDB3 NAM$B_NAME(R10),- ;Calculate length of name.type;ver place in R6 NAM$B_TYPE(R10),R6 ;Add length of name + type ADDB2 NAM$B_VER(R10),R6 ;Add length of version MOVAL OUTLINE(R9),R7 ;Base address of outline MOVZBL COL(R9),R0 ;add zero extended byte COL(R9) to longword R7 ADDL2 R0,R7 ;R7 = Address to start filename MOVC3 R6,@NAM$L_NAME(R10),(R7) ;Move next filename in there ADDB2 R6,COL(R9) ;COL := COL + LENGTH(NAME.TYPE;VERS) ;7. Check DIRFLGS for qualifiers like /SIZE and /DATE ; A. If no qualifiers present then goto loop ;CHECK FOR QUALIFIERS LIKE /SIZE AND /DATE TSTB DIRFLGS(R9) ;Check for qualifiers like /SIZE or /DATE BNEQ QUAL ;Branch if qualifiers present BRW SRCHLP ;Otherwise goto search_loop (step 3) ; B. Print outline if filename too long ;/SIZE AND/OR /DATE PRESENT ;PRINT OUT CURRENT LINE IF FILENAME TOO LONG QUAL: CMPB COL(R9),#<SIZCOL-1> ;Check column offset. Check for extra-long filename BLEQ GETATR ;Branch if ok MOVL #GETATR_CODE,R1 ;Else print out line and return to FILATR BRW PRINT ;Get file attributes GETATR: PUSHL R9 ;Address of FAB CALLS #1,G^SYS$OPEN ;Open the file to get file attributes BLBS R0,1$ ;Branch if OK ;Call sys$getmsg to get error message text and place it in outline ;R2 becomes address of temporary descriptor built on stack for outline string ;R3 becomes address of resulting message string length PUSHL #0 ;Build temp descriptor on stack PUSHL #0 ;for dir-spec string MOVL SP,R2 ;Save address of descriptor in R2 MOVW #<NAM$C_MAXRSS-SIZCOL>,DSC$W_LENGTH(R2) ;Length of outline string buffer (what's left) MOVB #DSC$K_DTYPE_T, DSC$B_DTYPE(R2) ;Descriptor type MOVB #DSC$K_CLASS_S, DSC$B_CLASS(R2) ;Descriptor Class ADDL3 #<OUTLINE+SIZCOL>,R9, DSC$A_POINTER(R2);Address of dirspec string buffer PUSHL #0 ;Place for return length MOVL SP,R3 ;Address of above (by reference) PUSHL #0 ;Now call $getmsg. outadr. PUSHL #1 ;flags. include only message text PUSHL R2 ;bufadr (by descriptor) PUSHL R3 ;msglen (by reference) PUSHL R0 ;msgid CALLS #5,G^SYS$GETMSG ;Get message text into outline ADDB3 #SIZCOL,(R3),COL(R9) ;Add message text length to col ADDL2 #12,SP ;Restore stack pointer MOVL #SRCHLP_CODE,R1 ;Set return code BRW PRINT ;Print outline ;File successfully opened. Close file and process qualifiers. 1$: PUSHL R9 ;Address of FAB CALLS #1,G^SYS$CLOSE ;Close the file ; D. Add size info if requested ;CHECK FOR /SIZE GETSIZ: BITB #GET_SIZE,DIRFLGS(R9) ;Do we have /SIZE BEQL GETDAT ;no, branch to get date MOVL <XABFHC+XAB$L_EBK>(R9),R4 ;Move file size to R4 TSTW <XABFHC+XAB$W_FFB>(R9) ;First free byte = 0? BNEQ 2$ ;If not, EBK = Blocks in use. DECL R4 ;Else don't count last block ;Call sys$fao to put file size in outline string 2$: PUSHL #0 ;Build temp descriptor on stack for outbuf PUSHL #0 ;R2 becomes address of temporary descriptor MOVL SP,R2 ;Save address of descriptor in R2 MOVW #SIZLEN, DSC$W_LENGTH(R2) ;Length of string MOVB #DSC$K_DTYPE_T, DSC$B_DTYPE(R2) ;Descriptor type MOVB #DSC$K_CLASS_S, DSC$B_CLASS(R2) ;Descriptor Class ADDL3 #<SIZCOL+OUTLINE>,R9,DSC$A_POINTER(R2) ;Base address of DIRBLK + offset = start address for size string PUSHL R4 ;P1 = filesize PUSHL R2 ;Address of outbuf descriptor PUSHL #0 ;Outlen PUSHAL FAOSIZE ;Ctrstr CALLS #4,G^SYS$FAO ;Write size to outline ADDL2 #8,SP ;Restore stack pointer MOVB #<SIZCOL+SIZLEN>,COL(R9) ;Move col pointer to end of size ; E. Add date info if requested GETDAT: BITB #GET_DATE,DIRFLGS(R9) ;Do we have /DATE BEQL 1$ ;no, branch to rest PUSHL #0 ;Build temp descriptor on stack for date string PUSHL #0 ;R2 becomes address of temporary descriptor MOVL SP,R2 ;Save address of descriptor in R2 MOVW #DATLEN,DSC$W_LENGTH(R2) ;Length of date MOVB #DSC$K_DTYPE_T, DSC$B_DTYPE(R2) ;Descriptor type MOVB #DSC$K_CLASS_S, DSC$B_CLASS(R2) ;Descriptor Class ADDL3 #<DATCOL+OUTLINE>,R9,DSC$A_POINTER(R2) ;Base address of DIRBLK + offset = start address for date string PUSHL #0 ;cvtflg PUSHAL <XABDAT+XAB$Q_CDT>(R9) ;timadr PUSHL R2 ;timbuf PUSHL #0 ;timlen CALLS #4,G^SYS$ASCTIM ;Convert binary time to ASCII string ADDL2 #8,SP ;Restore stack pointer MOVB #<DATCOL+DATLEN>,COL(R9) ;Set col pointer to end of date 1$: MOVL #SRCHLP_CODE,R1 ;Set return code BRB PRINT ;Print outline ;-- ;Print outline ;R1 = retcode PRINT: PUSHAB OUTLINE(R9) ;address of output string MOVZBL COL(R9),R0 ;length of output string PUSHL R0 ;length of output string PUSHL R1 ;retcode CALLS #3,FMTOUTSTR ;format output string MOVC5 #0,(SP),#SPACE,#OUTLNLEN,OUTLINE(R9) ;Clear outline CLRB COL(R9) ;Reset COL to 0 RET ;Print OUTSTR. TPU editor should call us again passing RETCODE ;-- ;Print outline, deallocate memory, and return CLEANUP: ;Print outline ;R1 = retcode PUSHAB OUTLINE(R9) ;address of output string MOVZBL COL(R9),R0 ;length of output string PUSHL R0 ;length of output string PUSHL R1 ;retcode CALLS #3,FMTOUTSTR ;format output string ;Deallocate memory MOVL #DIRBLKLEN,-(SP) ;Length of memory block to deallocate MOVL SP,R0 ;Address of above (by reference) PUSHAL VM_ZONE ;Our virtual memory zone id PUSHAL DIRBLKBSE ;Address of return address of memory block allocated PUSHL R0 ;Address containing length of memory to allocate CALLS #3,G^LIB$FREE_VM ;Attempt to deallocate memory previously in use CLRL (SP)+ ;Restore stack pointer CLRL DIRBLKBSE ;Reset base pointer to zero RET ;-- ;Signal unexpected error ERR: PUSHL R0 ;else signal error (could be Directory Not Found, Invalid Device Name, etc) CALLS #1,EDX_SIGNAL ; MOVL #RMS_ERR,R1 ;set return code to error RSB ;------------------------------------------------------------------------------ .SUBTITLE GETDEFDIRFLGS ;++ ; ; Functional Description: ; Attempts to translate DCL symbol 'DIR' and determine if /SIZE ; or /DATE qualifiers are present. ; ; Calling Sequence: ; CALLS #1,GETDEFDIRFLGS ; ; Arguments: ; 4(AP) = byte to put dirflgs in ; ; Outputs: ; R1 = dirflgs. ; ; Outline: ; 1. Memory is allocated on the stack ; 2. LIB$GET_SYMBOL is called to obtain the symbol translation ; 3. CLI$PRESENT is called to determine if qualifiers are present ; and dirflgs is set accordingly. ; ; Memory Map (Memory allocated on stack): ; ; MEMORY ALLOCATED ON STACK: ; -----------------------------------------(String to contain symbol name translation) ; | BUFFER | <^x00> (base address is stored in R9) ; | . | ; | . | ; | | ; -----------------------------------------(descriptor for string containing symbol translation) ; | class | dtype | string length | <BUFLEN> ; ----------------------------------------- ; | buffer address | <BUFLEN+^x04> ; ----------------------------------------- ; | TBLIND | <BUFLEN+^x08> ; -----------------------------------------(original stack pointer) ; | <BUFLEN+^x0C> ; Register usage: ; R9 = used as base address of memory allocated on stack ; ;------------------------------------------------------------------------------ .PSECT STATIC RD,NOWRT,NOEXE,LONG,PIC .ALIGN LONG DIR: .ASCID /DIR/ ;------------------------------------------------------------------------------ .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY GETDEFDIRFLGS,^M<R2,R9> ;Initialize MOVAB G^LIB$SIG_TO_RET,(FP) ;Establish handler for signals from CLI$DCL_PARSE and CLI$PRESENT CLRL @4(AP) ;Initialize dirflgs SUBL2 #<BUFLEN+^x0C>,SP ;Allocate memory on stack MOVL SP,R9 ;Store base address in R9 ;Initialize descriptor MOVL #BUFLEN, <BUFLEN+DSC$W_LENGTH >(R9) ;Length MOVB #DSC$K_DTYPE_T, <BUFLEN+DSC$B_DTYPE >(R9) ;Type MOVB #DSC$K_CLASS_S, <BUFLEN+DSC$B_CLASS >(R9) ;Class MOVL R9, <BUFLEN+DSC$A_POINTER>(R9) ;Address ;Translate DCL symbol PUSHAL <BUFLEN+^x08>(R9) ;Table indicator PUSHAW <BUFLEN>(R9) ;Return length PUSHAL <BUFLEN>(R9) ;Return buffer PUSHAL DIR ;Address of descriptor of DCL symbol 'DIR' to translate CALLS #4,G^LIB$GET_SYMBOL ;Translate symbol BLBC R0,19$ ;Branch on failure ;Parse string and restore stack PUSHAL G^DCL$AL_TAB_VEC ;Address of command table for parse (use system DCLTABLES) PUSHAL <BUFLEN>(R9) ;Address of input string descriptor CALLS #2,G^CLI$DCL_PARSE ;Parse input string BLBC R0,19$ ;Check success of DCL_PARSE (actually our handler will/should get the error) ;CHECK FOR /SIZE AND /DATE PUSHAL SIZE ;Check for /SIZE present in command string CALLS #1,G^CLI$PRESENT ; BLBC R0,13$ ;Branch if not present BISB2 #GET_SIZE,@4(AP) ;Set /SIZE flag 13$: PUSHAL DATE ;Check for /DATE present in command string CALLS #1,G^CLI$PRESENT ; BLBC R0,19$ ;Branch if not present BISB2 #GET_DATE,@4(AP) ;Set /DATE flag 19$: RET ;------------------------------------------------------------------------------ ;============================================================================== ; EDX SORT ;============================================================================== .SUBTITLE EDX_SORT ; ;++ ;Sort Routines: ; EDX_SORT !Main entry. Parses R6 ; SORT_PREPARSE !Preparse SORT command ; SORT_PASSFILES !Pass filenames for file sort ; SORT_POSTPARSE !Finish parsing SORT command ; SORT_DO_FILE !Do file sort ; SORT_RELEASE_REC !Give record to sort when using record sort ; SORT_RETURN_REC !Get record when using record sort ; ; ; Functional Description: ; Sorts using either file sort or record sort. This routine uses ; the VMS Sort/Merge (SOR) Utility Routines as described in the ; VAX/VMS Utilities Routines Reference Manual. ; ; Calling Sequence: ; CALLS #0,EDX_SORT ; ; Argument inputs: ; R6 = Code describing subfunction to perform (low word of INCODE) ; 1. Preparse command line ; 2. Pass files and do sort (for file sort) ; 3. Postparse command line ; 4. Pass a record to sort. (Repeat until all records passed) ; 5. Do record sort ; 6. Receive a record in sorted order. (Repeat until all records received) ; 7. Cleanup ; ; Usage: ; Either file sort or record sort is used. ; ; With file sort, you pass it the name of a file on disk to sort, ; it sorts the file creating a new file and returns to you the name of ; the new file created. ; ; With record sort, you pass it individual records (a record is a line ; of text from the buffer), passing it one record per call until all ; records have been passed. The records are sorted, and then returned ; to you one record per call, in sorted order, until all records have ; been returned to you. ; ; Which sorting method to use: ; File sort can handle all situations. It is the method of choice ; when a large number of records are to be sorted, since it is faster ; to write a large buffer to disk than to pass it one line at a time ; to and from sort, and there is no limit to the length of line which ; can be sorted. However, the file sort method takes a minimum of ; a couple seconds because of time it takes to create a temporary ; file on disk and then delete it. ; ; Record sort is suitable when a small number of lines are to be ; quickly sorted, and the lines are < 132 characters in length (SRT_MAXLRL). ; As the number of records to sort increases, there reaches a point ; where it becomes faster to use the file sort method instead. ; ; Sequence of calls for performing file sort: ; 1. Call n=1 'Preparse command line' passing the SORT command ; line to be parsed. Returns indicating if SORT BUFFER, ; SORT RANGE, HELP, or error in sort command. ; 2. Call n=2 'Pass files and do sort' passing it name of file to sort. ; Returns name of sorted file created. ; ; Sequence of calls for performing file sort: ; 1. Call n=1 'Preparse command line' passing the SORT command ; command line to be parsed. Returns indicating if SORT BUFFER, ; SORT RANGE, HELP, or error in sort command. ; 2. Call n=3 'Postparse command line' ; 3. Call n=4 'Pass a record to sort' passing it one record from ; the buffer. Repeat this call until all records have been ; passed. ; 4. Call n=5 'Do record sort' to perform the actual sort ; 5. Call n=6 'Receive a record in sorted order'. Returns one ; record. Repeat until all records have been passed back in ; sorted order. ; 6. Call n=7 'Cleanup' to free up memory allocated by sort. ; ;---------------------------------------------------------------------- ; Internal sequence for performing file sort: ; 1. EDX calls SORT_PREPARSE passing it the SORT command line. ; SORT_PREPARSE parses the command line. If there is an error ; it returns with error status. Otherwise it returns indicating ; wheter SORT BUFFER or SORT RANGE was specified on command line. ; 2. EDX writes a temporary file to disk to be sorted. ; 3. EDX calls SORT_PASSFILES passing it the name of the temporary ; file to be sorted. SORT_PASSFILES generates a filename for ; the output file, and then calls SOR$PASS_FILES passing the names ; of the input file and the output file. ; 4. SORT_POSTPARSE is called. It extracts the information from CLI ; about the previously parsed SORT command, and calls SOR$BEGIN_SORT. ; 5. SORT_DO_FILE is called, which calls SOR$SORT_MERGE to do the actual ; sort. It also calls SOR$END_SORT to clean up afterwards. ; ; Internal sequence for performing record sort: ; 1. EDX calls SORT_PREPARSE passing it the SORT command line. ; SORT_PREPARSE parses the command line. If there is an error ; it returns with error status. Otherwise it sets OUTSTR indicating ; wheter SORT BUFFER or SORT RANGE was specified on command line. ; 2. SORT_POSTPARSE is called. It extracts the information from CLI ; about the previously parsed SORT command, and calls SOR$BEGIN_SORT. ; Return to user with OUTSTR previously set. ; 3. SOR$RELEASE_REC is called for n=4. ; 4. SOR$SORT_MERGE is called for n=5. ; 5. SOR$RETURN_REC is called for n=6. ; 6. SOR$END_SORT is called for n=7. ; ; Note: ; The SOR$... symbols are defined in the SYS$LIBRARY:SORTSHR.EXE ; shareable image. The linker should resolve these symbols ; automatically, as part of its search through the images in the ; system shareable image library SYS$LIBRARY:IMAGELIB.OLB. ; ;------------------------------------------------------------------------------ .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY EDX_SORT,^M<R2> ;Case entry code ;R6 = Entry code passed by caller CASEB R6, #1, #<7-1> ;Case entry point to jump to 1$: .WORD SRFINI-1$,- ; 1 = Sort initialize for file sort SRFDOF-1$,- ; 2 = Do file sort SRRINI-1$,- ; 3 = Sort initialize for record sort SRRPAS-1$,- ; 4 = Pass a record to sort SRRDOR-1$,- ; 5 = Do record sort SRRREC-1$,- ; 6 = Receive a record in sorted order SRRFIN-1$ ; 7 = Cleanup record sort PUSHL #EDX__UNKNCODE ;Unknown item code CALLS #1,EDX_SIGNAL ;Signal internal error RET ;and return ; 1. Preparse sort command SRFINI: CALLS #0,SORT_PREPARSE RET ; 2. Pass filenames and do sort SRFDOF: CALLS #0,SORT_PASSFILES BLBS R0,10$ RET ;error return. PASSFILES signaled and made OUTSTR 10$: PUSHL #0 ;0 = using file sort CALLS #1,SORT_POSTPARSE BLBS R0,20$ ;branch if OK PUSHL R0 CALLS #1,FMTOUTSTR ;format output string RET 20$: CALLS #0,SORT_DO_FILE RET ; 3. Postparse command line SRRINI: PUSHL #1 ;1 = using record sort CALLS #1,SORT_POSTPARSE PUSHL R0 CALLS #1,FMTOUTSTR ;format output string RET ; 4. Pass a record to sort SRRPAS: CALLS #0,SORT_RELEASE_REC RET ; 5. Do record sort SRRDOR: CALLS #0,G^SOR$SORT_MERGE CHECK_STATUS PUSHL R0 ;retcode CALLS #1,FMTOUTSTR ;format output string RET ; 6. Receive a record in sorted order SRRREC: CALLS #0,SORT_RETURN_REC RET ; 7. Cleanup record sort SRRFIN: CALLS #0,G^SOR$END_SORT ;cleanup PUSHL R0 ;retcode CALLS #1,FMTOUTSTR ;format output string RET ;------------------------------------------------------------------------------ ;++ ; SORT_PREPARSE ; ; Functional Description: ; Parses the command line for correctness and returns indicating ; if BUFFER or RANGE was specified. We hold off on examining the ; rest of the results from the parsed command line until after ; SOR$PASS_FILES has been called (if file sort is being used), then ; the rest is done in SORT_POSTPARSE. ; ; Calling Sequence: ; CALLS #0,SORT_PREPARSE ; ; Argument inputs: ; INSTR = Command line to be parsed ; ; Outputs: ; OUTSTR - return value indicating domain to be sorted. ; = 0 error occurred ; = 1 BUFFER was specified ; = 2 RANGE was specified ; = 3 HELP was specified ; ; ; STORAGE ALLOCATED ON STACK ; ----------------------------------------- ; | class | dtype | string length | 0(R9) scratch character buffer ; ----------------------------------------- ; | buffer address | ; ----------------------------------------- ; | 8 character buffer for name | ; - - ; | | ; ----------------------------------------- ; ;-- .PSECT STATSHR RD,NOWRT,NOEXE,LONG,PIC,SHR DOMAIN: .ASCID "DOMAIN" BUFFER: .ASCII "BUFFER" RANGE: .ASCII "RANGE" .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY SORT_PREPARSE,^M<R2,R9,R10,R11> ;Clean up any outstanding sort CALLS #0,G^SOR$END_SORT ;clean up incase previous unfinished sort was active ; Allocate memory MOVL SP,R0 ;Save original SP SUBL2 #<8+8>,SP ;memory for string buffer and descriptor MOVL SP,R9 ;save address MOVW #8, DSC$W_LENGTH(R9) ;Descriptor length MOVB #DSC$K_DTYPE_T, DSC$B_DTYPE(R9) ;Fill in Type MOVB #DSC$K_CLASS_S, DSC$B_CLASS(R9) ;Fill in Class MOVAB 8(R9), DSC$A_POINTER(R9) ;Buffer address ;The command is parsed. PUSHAL EDX_COMMANDS ;Address of command table for parse PUSHL INSTR ;Address of input string descriptor CALLS #2,G^CLI$DCL_PARSE ;Parse input string BLBC R0,180$ ;Branch on failuer ;Now see if BUFFER or RANGE was specified PUSHL R9 ;address of scratch buffer PUSHL R9 ;address of scratch buffer PUSHAQ DOMAIN ;Get DOMAIN CALLS #3,G^CLI$GET_VALUE CMPC3 (R9),8(R9),BUFFER BNEQ 160$ PUSHL #3 ;retcode CALLS #1,FMTOUTSTR ;set return status RET 160$: CMPC3 (R9),8(R9),RANGE BNEQ 170$ PUSHL #2 ;retcode CALLS #1,FMTOUTSTR ;set return status RET 170$: CMPC3 (R9),8(R9),HELP BNEQ 180$ PUSHL #4 ;retcode CALLS #1,FMTOUTSTR ;set return status RET 180$: PUSHL #0 ;0 means error CALLS #1,FMTOUTSTR ;set return status RET ;------------------------------------------------------------------------------ ;++ ; SORT_PASSFILES ; ; Functional Description: ; Calls G^SOR$PASS_FILES, passing the name of the input filename to ; be sorted, and the output filename to create. The input filename ; of the file to sort is passed to us in INSTR. The output filename ; is generated by us here. It is of the form "EDX_TEMPSORT00000000.SRT" ; where the 00000000 is the current process's PID in hexadecimal. ; We use the current process's PID as part of the filename to help ; make the filename unique. ; ; Calling Sequence: ; CALLS #0,SORT_PASSFILES ; ; Argument inputs: ; INSTR = Input filename to pass to G^SOR$PASS_FILES ; ; Outputs: ; OUTSTR = Output filename we generated, with return status of 1 ; ; Outline: ; The output filename is of the form: EDX_TEMPSORT00000000.SRT ; where the 00000000 is replaced by the process's PID number. ; 1. Memory for output filename buffer is allocated on stack ; 2. The output filename is moved into the buffer ; 3. The process's PID is determined by calling SYS$GETJPI ; 4. 00000000 of the output filename is replaced by the ; process's PID number. (OTS$CVT_L_TZ) ; 5. G^SOR$PASS_FILES is called, passing the input filename from INSTR, ; and the output filename we created. ; 6. If success, then our generated output filename is copied to OUTSTR ; (for temporary storage). ; ; STORAGE ALLOCATED ON STACK ; ----------------------------------------- ; | class | dtype | string length | (R9) string descriptor ; ----------------------------------------- ; | buffer address | ; ----------------------------------------- ; | JPI$_PID | 4 | itemlist for call to SYS$GETJPI ; ----------------------------------------- ; | address of -4(R10) | ; ----------------------------------------- ; | 0 | ; ----------------------------------------- ; | 0 | ; ----------------------------------------- ; | process's PID | -4(R10) PID ; ----------------------------------------- ; | buffer for output filename | (R10) ; . . ; . . ; ----------------------------------------- ; ; Registar usage: ; R10 - Points to beginning of output filename buffer ;-- .PSECT STATSHR RD,NOWRT,NOEXE,LONG,PIC .ALIGN LONG SORFN: .ASCII /EDX_TEMPSORT/ ;Sort file NAME SORFNL= .-SORFN ;Length of sort file NAME SORFT: .ASCII /.SRT/ ;Sort file TYPE SORFTL= .-SORFT ;Length of sort file TYPE SORFPL= 8 ;Length of PID SORFLL=SORFNL+SORFPL+SORFTL ;Sort file length total .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY SORT_PASSFILES,^M<R9,R10> ; 1. Memory for output filename buffer is allocated on stack SUBL2 #SORFLL,SP ;allocate buffer for output filename BICB2 #^B0011,SP ;longword align stack pointer MOVL SP,R10 ;Save address of output filename buffer ; 2. The output filename is moved into the buffer MOVC3 #SORFNL, SORFN, (R10) ;Copy over "EDX_TEMPSORT" MOVC5 #0,(SP),#^A"0",#SORFPL,SORFNL(R10) ;fill PID range with "00000000" MOVC3 #SORFTL, SORFT, <SORFNL+SORFPL>(R10) ;Copy over ".SOR" ; 3. The process's PID is determined by calling SYS$GETJPI ; Create itemlist for GETJPI PUSHL #0 ;longword buffer for PID -4(R10) PUSHL #0 ;end of itemlist PUSHL #0 ;return length address PUSHAL -4(R10) ;buffer address MOVW #JPI$_PID,-(SP) ;item code MOVW #4,-(SP) ;buffer length MOVL SP,R0 ;save address of itemlist ; Call GETJPI PUSHL #0 ;efn PUSHL #0 ;pidadr PUSHL #0 ;prcnam PUSHL R0 ;itmlst PUSHL #0 ;iosb PUSHL #0 ;astadr PUSHL #0 ;astprm CALLS #7,G^SYS$GETJPIW BLBS R0,40$ PUSHL R0 ;else error... PUSHL R0 CALLS #1,EDX_SIGNAL CALLS #1,FMTOUTSTR RET ; 4. 00000000 of the output filename is replaced by the process's PID number. ; Build descriptor of "00000000" substring within output filename string. 40$: SUBL2 #8,SP MOVL SP,R9 ;Save address of descriptor MOVW #SORFPL, DSC$W_LENGTH(R9) ;length of PID MOVB #DSC$K_DTYPE_T, DSC$B_DTYPE(R9) ;Type MOVB #DSC$K_CLASS_S, DSC$B_CLASS(R9) ;Class MOVAB SORFNL(R10), DSC$A_POINTER(R9) ;address PUSHL #SORFPL ;Min digits PUSHL R9 ;out-str (by descriptor) PUSHAL -4(R10) ;value (PID by reference) CALLS #2,G^OTS$CVT_L_TZ ;convert PID to hexadecimal text BLBS R0,50$ PUSHL R0 ;else error... PUSHL R0 CALLS #1,EDX_SIGNAL CALLS #1,FMTOUTSTR RET ; 5. G^SOR$PASS_FILES is called, passing the input filename from INSTR, ; and the output filename we created. ; Fudge descriptor so it points to full output filename string 50$: MOVW #SORFLL, DSC$W_LENGTH(R9) ;length of filename string MOVL R10, DSC$A_POINTER(R9) ;address of filename string PUSHL R9 ;out-file by descriptor PUSHL INSTR ;in-file by descriptor CALLS #2,G^SOR$PASS_FILES BLBS R0,60$ PUSHL R0 ;else error... PUSHL R0 CALLS #1,EDX_SIGNAL ;Signal error CALLS #1,FMTOUTSTR ;set OUTSTR RET ; 6. If success, then our generated output filename is copied to OUTSTR ; (for temporary storage). 60$: PUSHL R10 ;address of output string PUSHL #SORFLL ;length of output string PUSHL #1 ;retcode CALLS #3,FMTOUTSTR ;format output string RET ;------------------------------------------------------------------------------ ;++ ; SORT_POSTPARSE ; ; Functional Description: ; Extracts information from CLI about the previously parsed SORT command. ; Builds and item list of this information and calls SOR$BEGIN_SORT. ; ; Calling Sequence: ; CALLS #1,SORT_POSTPARSE ; ; Argument inputs: ; (AP) - number of arguments (#1 by value) ; 4(AP) - (0 or 1 by value) ; 0 = using file sort. ; 1 = using record sort. ; ; Outputs: ; R0 - Status. Signaled if bad. ; ; Implicit: ; It is assumed a SORT command line was preveously parsed by ; SORT_PREPARSE. ; ; Outline: ; 1. Memory is allocated on the stack. ; 2. The memory is filled in depending upon qualifiers found ; in the command string. The key_buffer itemlist is filled ; from the top down, with a new item added whenever a /KEYn ; sort key qualifier is found. ; 3. SOR$BEGIN_SORT is called to initialize the sort ; ; STORAGE ALLOCATED ON STACK ; ----------------------------------------- ; | option bits | (SP) ; ----------------------------------------- ; | number of keys | (not used) | key_buffer argument starts at -2(R11) ; ----------------------------------------- (R11) ; | 9 quadword itemlist of sort keys | <-- R10 points into key_buffer ; - (72 bytes) - ; . . (9 quadwords) ; . . ; - - ; | | ; ----------------------------------------- ; | | scratch longword ; ----------------------------------------- ; | class | dtype | string length | 0(R9) scratch character buffer ; ----------------------------------------- ; | buffer address | ; ----------------------------------------- ; | 255 character buffer for name | ; - - ; . . (64 longwords) ; . . ; ----------- - ; | not used| | ; ----------------------------------------- ; ; Registar usage: ; R11 - Points to the beginning of the key_buffer itemlist ; R10 - Points to the end of the key_buffer itemlist where new ; items are added. ; ; Notes: ; The SOR$... symbols are defined in the SYS$LIBRARY:SORTSHR.EXE ; shareable image. The linker should resolve these symbols ; automatically, as part of its search through the images in the ; system shareable image library SYS$LIBRARY:IMAGELIB.OLB. .PSECT DATA RD,WRT,NOEXE,LONG,PIC,NOSHR KEYn: .ASCID "KEYn" KEYn_POSITION: .ASCID "KEYn.POSITION" KEYn_SIZE: .ASCID "KEYn.SIZE" KEYn_DESCENDING: .ASCID "KEYn.DESCENDING" KEYn_REVERSE: .ASCID "KEYn.REVERSE" .PSECT STATSHR RD,NOWRT,NOEXE,LONG,PIC,SHR KEY: .ASCID "KEY" KEY_POSITION: .ASCID "KEY.POSITION" KEY_SIZE: .ASCID "KEY.SIZE" KEY_DESCENDING: .ASCID "KEY.DESCENDING" KEY_REVERSE: .ASCID "KEY.REVERSE" DESCENDING: .ASCID "DESCENDING" DUPLICATES: .ASCID "DUPLICATES" EBCDIC: .ASCID "EBCDIC" MULTINATIONAL: .ASCID "MULTINATIONAL" HELP: .ASCID "HELP" REVERSE: .ASCID "REVERSE" STABLE: .ASCID "STABLE" START: .ASCID "START" SRT_MAXLRL = 132 ;Maximum length of line we will support for record sort .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY SORT_POSTPARSE,^M<R2,R9,R10,R11> ; Allocate memory MOVL SP,R0 ;Save original SP SUBL2 #<255+8>,SP ;memory for string buffer MOVL SP,R9 ;save address SUBL2 #<10*8 +4>,SP ;memory for key_buffer MOVL SP,R10 ;set R10 points into key_buffer SUBL2 #2,SP ;for number of keys MOVL SP,R11 ;Set R11 points to key_buffer header SUBL2 #2,SP ;to longword align stack SUBL2 SP,R0 ;R0 = total length of memory allocated MOVC5 #0,(SP),#^x00,R0,(SP) ; Zero allocated memory MOVB #DSC$K_DTYPE_T, DSC$B_DTYPE(R9) ;Fill in Type MOVB #DSC$K_CLASS_S, DSC$B_CLASS(R9) ;Fill in Class MOVAB 8(R9), DSC$A_POINTER(R9) ;Buffer address ;Check for KEY qualifier 10$: PUSHAQ KEY ;Test for KEY, then test for KEY1 - KEY9 CALLS #1,G^CLI$PRESENT BLBS R0,12$ ;branch if present and process BRW 18$ ;Jump into loop for KEYn stuff 12$: MOVW #DSC$K_DTYPE_T, (R10) ;Fill in Type is text characters ;Check for KEY.DESCENDING and/or KEY.REVERSE (identical) PUSHAQ KEY_DESCENDING ;Test for KEY.DESCENDING CALLS #1,G^CLI$PRESENT BLBS R0,13$ ;branch if descending PUSHAQ KEY_REVERSE ;else check for REVERSE (identical function) CALLS #1,G^CLI$PRESENT BLBC R0,14$ ;branch if not descending 13$: MOVW #1,2(R10) ;set key descending (same as reverse) ;Get KEY.POSITION 14$: MOVW #<BUFLEN-1>,(R9) ;Reset descriptor length of scratch buffer PUSHL R9 ;scratch buffer PUSHL R9 ;scratch buffer PUSHAQ KEY_POSITION ;get POSITION=x for KEYn CALLS #3,G^CLI$GET_VALUE PUSHAB 4(R10) ;result by reference PUSHAB 8(R9) ;string by reference MOVZWL (R9),-(SP) ;length of string CALLS #3,G^LIB$CVT_DTB ;Convert string to number DECW 4(R10) ;Convert position to offset ;Get KEY.SIZE MOVW #<BUFLEN-1>,(R9) ;Reset descriptor length PUSHL R9 ;address of scratch buffer PUSHL R9 ;address of scratch buffer PUSHAQ KEY_SIZE ;Get SIZE CALLS #3,G^CLI$GET_VALUE PUSHAB 6(R10) ;result by reference PUSHAB 8(R9) ;string by reference MOVZWL (R9),-(SP) ;length of string CALLS #3,G^LIB$CVT_DTB ;Convert string to number INCW (R11) ;Increment count of number of keys ADDL2 #8,R10 ;Increment key_buffer pointer ;CHECK FOR KEYn QUALIFIERS 18$: MOVZBL #^A"1",R2 ;R2 counts from "1" to "9" 19$: PUSHAQ KEYn ;Test for KEY1 - KEY9 present MOVL (SP),R0 ;R0 = address of descriptor ADDL3 #3,4(R0),R0 ;R0 = address of n MOVB R2,(R0) ;make KEYn into KEY1 - KEY9 CALLS #1,G^CLI$PRESENT BLBS R0, 20$ ;branch if present and process BRW 100$ ;else loop ;Start next item on key_buffer itemlist 20$: MOVW #DSC$K_DTYPE_T, (R10) ;Fill in Type is text characters ;Check for key DESCENDING and/or REVERSE (identical) PUSHAQ KEYn_DESCENDING MOVL (SP),R0 ;R0 = address of descriptor ADDL3 #3,4(R0),R0 ;R0 = address of n MOVB R2,(R0) ;make KEYn_DESCENDING into KEY1_DESCENDING - KEY9_DESCENDING CALLS #1,G^CLI$PRESENT BLBS R0,29$ ;branch if descending PUSHAQ KEYn_REVERSE ;else check for REVERSE (identical function) MOVL (SP),R0 ;R0 = address of descriptor ADDL3 #3,4(R0),R0 ;R0 = address of n MOVB R2,(R0) ;make KEYn_REVERSE into KEY1_REVERSE - KEY9_REVERSE CALLS #1,G^CLI$PRESENT BLBC R0,30$ ;branch if not descending and not reverse 29$: MOVW #1,2(R10) ;set key descending (same as reverse) ;GET KEYn.POSITION 30$: MOVW #<BUFLEN-1>,(R9) ;Reset descriptor length of scratch buffer PUSHL R9 ;scratch buffer PUSHL R9 ;scratch buffer PUSHAQ KEYn_POSITION ;get POSITION=x for KEYn MOVL (SP),R0 ;R0 = address of descriptor ADDL3 #3,4(R0),R0 ;R0 = address of n MOVB R2,(R0) ;make KEYn_POSITION into KEY1_POSITION - KEY9_POSITION CALLS #3,G^CLI$GET_VALUE PUSHAB 4(R10) ;result by reference PUSHAB 8(R9) ;string by reference MOVZWL (R9),-(SP) ;length of string CALLS #3,G^LIB$CVT_DTB ;Convert string to number DECW 4(R10) ;Convert position to offset ;GET KEYn.SIZE MOVW #<BUFLEN-1>,(R9) ;Reset descriptor length PUSHL R9 ;address of scratch buffer PUSHL R9 ;address of scratch buffer PUSHAQ KEYn_SIZE ;Get SIZE MOVL (SP),R0 ;R0 = address of descriptor ADDL3 #3,4(R0),R0 ;R0 = address of n MOVB R2,(R0) ;make KEYn_SIZE into KEY1_SIZE - KEY9_SIZE CALLS #3,G^CLI$GET_VALUE PUSHAB 6(R10) ;result by reference PUSHAB 8(R9) ;string by reference MOVZWL (R9),-(SP) ;length of string CALLS #3,G^LIB$CVT_DTB ;Convert string to number INCW (R11) ;Increment count of number of keys ADDL2 #8,R10 ;Increment key_buffer pointer 100$: ACBW #^A"9", #1, R2, 19$ ;Loop until all /KEY processed 101$: TSTW (R11) ;Check that we have at least one key BNEQ 110$ ;branch if we had at least one KEYn ;Default sort values MOVW #DSC$K_DTYPE_T, (R10) ;Fill in Type is text characters CLRW 2(R10) ;sort defaults to ascending CLRW 4(R10) ;sort starts at offset 0 MOVW #132,6(R10) ;key length defaults to 132 MOVZBW #1,(R11) ;Count of number of keys is 1 PUSHAQ DESCENDING ;Check for /DESCENDING (same as /REVERSE) CALLS #1,G^CLI$PRESENT BLBS R0,106$ ;branch if present PUSHAQ REVERSE ;Check for /REVERSE (same as /DESCENDING) CALLS #1,G^CLI$PRESENT BLBC R0,107$ ;branch if not present 106$: MOVW #1,2(R10) ;set key descending 107$: PUSHAQ START CALLS #1,G^CLI$PRESENT BLBC R0,110$ ;branch if not present and check for /KEYn MOVW #<BUFLEN-1>,(R9) ;Reset descriptor length of scratch buffer PUSHL R9 ;scratch buffer PUSHL R9 ;scratch buffer PUSHAQ START ;get /START=value CALLS #3,G^CLI$GET_VALUE PUSHAB 4(R10) ;result by reference PUSHAB 8(R9) ;string by reference MOVZWL (R9),-(SP) ;length of string CALLS #3,G^LIB$CVT_DTB ;Convert string to number DECW 4(R10) ;Convert start position to offset MOVW #132,6(R10) ;reset key size to 132 (clobbered by CVT_DTB) 110$: PUSHL #SOR$M_NOSIGNAL ;place for option qualifiers MOVL SP,R2 ;R2 pointer to options bits PUSHAQ STABLE ;Test for /STABLE CALLS #1,G^CLI$PRESENT ; BLBC R0, 120$ ;Branch if not present BISL2 #SOR$M_STABLE,(R2) ;Set stable bit 120$: PUSHAQ EBCDIC ;Test for /EBCDIC CALLS #1,G^CLI$PRESENT ; BLBC R0, 125$ ;Branch if not present BISL2 #SOR$M_EBCDIC,(R2) ;Set EBCDIC bit 125$: PUSHAQ MULTINATIONAL ;Test for /MULTINATIONAL CALLS #1,G^CLI$PRESENT ; BLBC R0, 130$ ;Branch if not present BISL2 #SOR$M_MULTI,(R2) ;Set MULTINATIONAL bit 130$: PUSHAQ DUPLICATES ;Test for /NODUPLICATES CALLS #1,G^CLI$PRESENT ; CMPL R0, #CLI$_NEGATED ;test for /NODUPLICATES BNEQ 140$ ;branch if not BISL2 #SOR$M_NODUPS,(R2) ;Set noduplicates bit 140$: PUSHL #SRT_MAXLRL ;length of longest line if using record sort MOVL SP,R0 ;save address PUSHL R2 ;options by reference PUSHL #0 ;LRL (length of longest line) BLBC 4(AP),142$ ;if using file sort leave LRL=0 MOVL R0,(SP) ;else set to MAXLRL (by reference) 142$: PUSHL R11 ;key_buffer by reference CALLS #3,G^SOR$BEGIN_SORT BLBS R0,150$ ;check for error PUSHL R0 ;save R0 PUSHL R0 ;push for EDX_SIGNAL CALLS #1,EDX_SIGNAL ;signal error POPL R0 ;Restore R0 150$: RET ;------------------------------------------------------------------------------ ;++ ; SORT_DO_FILE ; ; Functional Description: ; Perform actual sort. ; ; Calling Sequence: ; CALLS #0,SORT_DO_FILE ; ; Implicit inputs: ; It is assumed that SOR$BEGIN_SORT has already been called ; (by SORT_POSTPARSE). ; ; Outputs: ; OUTSTR has already been set by SORT_PASSFILES with success code ; of 1 and string containing ouput filename. This will be used as ; our return string unless an error occurs here, in which case ; we remake OUTSTR with our own error information. ; ; Outline: ; 1. SOR$SORT_MERGE is called to sort file creating new output file ; 2. SOR$END_SORT is called to clean up ; .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY SORT_DO_FILE,^M<> CALLS #0,G^SOR$SORT_MERGE ;DO SORT BLBS R0,20$ ;branch if OK PUSHL R0 ;else error... PUSHL R0 CALLS #1,EDX_SIGNAL CALLS #1,FMTOUTSTR 20$: CALLS #0,G^SOR$END_SORT RET ;OUTSTR was set previously ;------------------------------------------------------------------------------ ;++ ; SORT_RELEASE_REC ; ; Functional Description: ; Pass a record to SORT when using record sort. Calls G^SOR$RELEASE_REC ; ; Calling Sequence: ; CALLS #0,SORT_RELEASE_REC ; ; Inputs: ; INSTR - record being released to SORT ; ; Outputs: ; Status in OUTSTR: 0 = error ; 1 = success ; 2 = line too long ; ; SRT_MAXLRL is maximum length of record we can do via record sort ;-- .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY SORT_RELEASE_REC,^M<R2> PUSHL INSTR ;Address of input string descriptor CALLS #1,G^SOR$RELEASE_REC BLBC R0,10$ ;branch on bad status PUSHL #1 ;good status CALLS #1,FMTOUTSTR ;format output string RET ;Check for line too long status 10$: MOVL R0,R2 ;Save return condition PUSHL R0 ;Return value MOVL SP,R0 ;R0 = address of return value PUSHL #SOR$_BAD_LRL ;error value to check for PUSHL SP ;address of error value to check for PUSHL R0 ;address of return value CALLS #2,G^LIB$MATCH_COND ;returns R0 = 0 if not require PC and PSL TSTL R0 BEQL 20$ ;branch if not SOR$_BAD_LRL MOVL #2,R0 ;Set return status to 2 (line too long) CALLS #1,FMTOUTSTR ;format output string RET 20$: PUSHL R0 ;else error... CALLS #1,EDX_SIGNAL PUSHL #0 ;return 0 for error CALLS #1,FMTOUTSTR RET ;------------------------------------------------------------------------------ ;++ ; SORT_RETURN_REC ; ; Functional Description: ; Returns a record when using record sort ; ; Calling Sequence: ; CALLS #0,SORT_RETURN_REC ; ; Outputs: ; OUTSTR - returned record. ; ; Memory Map (Memory allocated on stack): ; ; MEMORY ALLOCATED ON STACK: ; -----------------------------------------(String to contain record returned by SOR$RETURN_REC) ; | BUFFER | (R9) ; | . | ; | . | ; | | ; -----------------------------------------(descriptor for string in which record is returned by SOR$RETURN_REC ; | class | dtype | string length | <SRT_MAXLRL>(R9) ; ----------------------------------------- ; | buffer address | <SRT_MAXLRL+^x04>(R9) ; ----------------------------------------- ; | <SRT_MAXLRL+^x08>(R9) ; Register usage: ; R9 = used as base address of memory allocated on stack ; ;------------------------------------------------------------------------------ .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY SORT_RETURN_REC,^M<R9> SUBL2 #<SRT_MAXLRL+^x08>,SP ;ALLOCATE MEMORY ON STACK MOVL SP,R9 ;Store base address in R9 MOVW #SRT_MAXLRL, <SRT_MAXLRL+DSC$W_LENGTH >(R9) ;Length ;INITIALIZE DESCRIPTOR MOVB #DSC$K_DTYPE_T, <SRT_MAXLRL+DSC$B_DTYPE >(R9) ;Type MOVB #DSC$K_CLASS_S, <SRT_MAXLRL+DSC$B_CLASS >(R9) ;Class MOVL R9, <SRT_MAXLRL+DSC$A_POINTER>(R9) ;Address PUSHAW <SRT_MAXLRL>(R9) ;length by reference will go into descriptor PUSHAQ <SRT_MAXLRL>(R9) ;descriptor CALLS #2,G^SOR$RETURN_REC ;Get next string (in sorted order) BLBS R0,1$ CMPL R0,#SS$_ENDOFFILE BEQL 1$ CHECK_STATUS 1$: MOVQ <SRT_MAXLRL>(R9),-(SP) ;descriptor PUSHL R0 ;retcode CALLS #3,FMTOUTSTR ;format output string RET ;============================================================================== ; EDX SPELL ;============================================================================== ;Constants BLOCK_SIZE = 512 ;Number of bytes in a block SPACE = ^x20 ;Ascii space character ;DEFINE OFFSETS INTO DICTIONARY HEADER BLOCK DIC_VERNO = ^x00 ;Dictionary version number DIC_HID = ^x01 ;Dictionary header ID DIC_LEXVBN = ^x04 ;Dictionary lexical database starting virtual block number DIC_LEXBLN = ^x08 ;Dictionary lexical database size in blocks DIC_INDVBN = ^x0C ;Dictionary index starting virtual block number DIC_INDLEN = ^x10 ;Dictionary index length in bytes DIC_INDSWD = ^x14 ;Dictionary index size of word = INDSWD (constant) DIC_INDPLN = ^x18 ;Dictionary index block size (number of lexical database blocks between index words) DIC_CWDVBN = ^x1C ;Dictionary common word list starting virtual block number DIC_CWDLEN = ^x20 ;Dictionary common word list length DICVERNO = 2 ;EDX Dictionary Version Number .PSECT DATA RD,WRT,NOEXE,LONG,PIC,NOSHR .ALIGN LONG DICFABIO: ; Fab used for I/O $FAB FNM = <EDX_DICTIONARY>, - ; Output file name DNM = <SYS$LIBRARY:EDX_DICTIONARY.DAT>, - NAM = DICNAMIO, - FAC = <BIO,GET>, - ; Block I/O write operation SHR = <GET> DICRABIO: $RAB FAB = DICFABIO ; Pointer to FAB DICNAMIO: ; NAM block for resulting filename $NAM ESS = NAM$C_MAXRSS DICFABMAP: ; Fab used for mapping lexical database to memory $FAB FNM = <EDX_DICTIONARY>, - ; Output file name DNM = <SYS$LIBRARY:EDX_DICTIONARY.DAT>, - FOP = <UFO>, - FAC = <GET>, - SHR = <GET,UPI>, - ;UPI must be set says the book RTV = -1 ;keep all pointers PERSDICFAB: ; Personal dictionary $FAB FNM = <EDXPERSDIC>, - DNM = <SYS$LOGIN:EDXPERSDIC.DAT>, - FAC = <GET>, - SHR = <GET> PERSDICRAB: $RAB FAB = PERSDICFAB, - ; Pointer to FAB UBF = WDBUF,- USZ = WDBUF_SIZE WDBUF_SIZE = 80 ;personal dictionary inword buffer size WDBUF: .BLKB WDBUF_SIZE ;personal inword buffer .ALIGN LONG DIC_HEADER: .LONG 0 ;address of dictionary header block DIC_INDEX: .LONG 0 ;address of dictionary index blocks DIC_CMNWDS: .LONG 0 ;address of common words DIC_LWL: .LONG 0 ;last misspelled word length DIC_LWA: .LONG 0 ;copy of last misspelled word (address) ASSUME DIC_LWL+4 EQUAL DIC_LWA ;DIC_LWL + DIC_LWA form descriptor MAPRANGE: .LONG ^x200, ^x200 ;any program (P0) region address LEXDBA: .BLKL 2 ;Lexical Database Address (address range returned here) ;------------------------------------------------------------------------------ .PSECT CODE NOWRT,EXE,PIC,LONG,SHR .ENTRY EDX_SPELL,^M<> ;Case entry code ;R6 = Entry code passed by caller TSTL DIC_HEADER BNEQ 10$ CALLS #0,SPELL_INIT ;initialize spelling checker BLBS R0,10$ ;branch if OK PUSHL R0 ;error return status CALLS #1,FMTOUTSTR ;set return status RET ;and return with error status (status already printed by SPELL_INIT) 10$: CASEB R6, #1, #<8-1> ;Case entry point to jump to 1$: .WORD DICBPA-1$,- ; 1 = Dictionary browse previous page DICBRW-1$,- ; 2 = Dictionary browse using word DICBPZ-1$,- ; 3 = Dictionary browse next page SPLTXT-1$,- ; 4 = Spell textline SPLGUS-1$,- ; 5 = Spell guess ACEPTW-1$,- ; 6 = Accept word (add to accepted word list) PERDIC-1$,- ; 7 = Add word to personal dictionary DMPCMW-1$ ; 8 = Dump commonword list PUSHL #EDX__UNKNCODE ;Unknown item code CALLS #1,EDX_SIGNAL ;Signal internal error RET ;and return DICBPA: DICBRW: DICBPZ: CALLS #0,DIC_BROWSE RET SPLTXT: PUSHL INSTR CALLS #1,SPELL_TEXTLINE RET SPLGUS: CALLS #0,SPELL_GUESS RET ACEPTW: CALLS #0,SPELL_ACCEPT_WORD RET PERDIC: CALLS #0,ADD_PERSDIC RET DMPCMW: CALLS #0,DUMP_COMMONWORDS RET ;------------------------------------------------------------------------------ .SUBTITLE SPELL_INIT ;++ ; ; Functional Description: ; Initializes the EDX dictionary. Opens all necessary files, ; reads in all necessary data. On error prints error and returns ; error status. ; Uses system service routine $CRMPSC to map the dictionary straight ; into memory. This method does not use up any user pgflquo quota. ; ; Calling Sequence: ; CALLS #0,SPELL_INIT ; ; Outputs: ; R0 = STATUS ; ; Outline: ; 1. A test is made to see if the initialization has already ; been done. ; 2. The EDX dictionary database file EDX_DICTIONARY.DAT is opened ; and connected to. ; 3. The rest of the file is mapped into memory using $CRMPSC. ; 4. Pointers to the index, common words, and lexical database are set. ; 5. User's personal dictionary file, if one is found, is opened ; and the words there are inserted into the binary tree of accepted ; words. ; ; Memory Map (Memory allocated on stack): ; ----------------------------------------- ; | buffer for filename | DICNAMIO+NAM$B_ESA ; | . | ; | . | ; | | ; ----------------------------------------- ; ;Registar usage: ; R11 = DIC_HEADER starting address of dictionary header block in memory ;-- .PSECT CODE NOWRT,EXE,PIC,LONG,SHR .ENTRY SPELL_INIT,^M<R2,R9,R10,R11> TSTL DIC_HEADER ;check if we've already initialized BEQL 1$ MOVL #SS$_NORMAL,R0 RET ;Initialization already done 1$: PUSHL #EDX__DICLOAD ;loading dictionary message CALLS #1,EDX_SIGNAL ;signal message SUBL2 #NAM$C_MAXRSS,SP ;Allocate buffer for filename BICB2 #^B0011,SP ;longword align stack pointer MOVL SP,DICNAMIO+NAM$L_ESA ;Store buffer address in NAM block $OPEN FAB=DICFABIO ;Open EDX dictionary file BLBC R0,2$ ;branch if error $CONNECT RAB=DICRABIO ;Connect to input BLBS R0,3$ ;branch if OK 2$: PUSHL #0 ;0 FAO args PUSHL R0 ;Error status PUSHAL BELL ;Ring terminal bell CALLS #1,G^LIB$PUT_OUTPUT ; PUSHL DICNAMIO+NAM$L_ESA ;filename addresss MOVZBL DICNAMIO+NAM$B_ESL,-(SP) ;filename size PUSHL #2 ;2 FAO args PUSHL #EDX__ERROPENDIC ;error opening dictionary file message CALLS #6,EDX_SIGNAL ;signal message MOVL #EDX__ERROPENDIC,R0 ;set return status RET ;Allocate memory for dictionary header block ;Address to return start position of block is DIC_HEADER 3$: JSB INITVMZONE MOVL #BLOCK_SIZE,-(SP) ;Length of memory block to allocate MOVL SP,R0 ;Address of above (by reference) PUSHAL VM_ZONE ;Our virtual memory zone id PUSHAL DIC_HEADER ;Address to place return address of memory block allocated PUSHL R0 ;Address containing length of memory to allocate (LNKFABLEN by reference) CALLS #3,G^LIB$GET_VM ;Allocate memory for new block in linked list CLRL (SP)+ ;Restore stack pointer BLBS R0,4$ ;branch if OK PUSHL #0 PUSHL R0 PUSHL #0 PUSHL #EDX__SPLINITERR ;spell init error CALLS #4,EDX_SIGNAL ;signal error MOVL #EDX__SPLINITERR,R0 ;set return status RET ;READ IN DICTIONARY HEADER 4$: MOVL DIC_HEADER,R11 ;Set R11 MOVL #1,DICRABIO+RAB$L_BKT ;Block number to read MOVL DIC_HEADER,DICRABIO+RAB$L_UBF ;Buffer MOVW #BLOCK_SIZE,DICRABIO+RAB$W_USZ ;Buffer size = 1 BLOCK $READ RAB=DICRABIO ;read in dictionary header block BLBS R0,10$ ;branch if OK PUSHL #0 PUSHL R0 PUSHL #0 PUSHL #EDX__SPLINITERR ;spell init error CALLS #4,EDX_SIGNAL ;signal error MOVL #EDX__SPLINITERR,R0 ;set return status RET ;CHECK VALIDITY OF HEADER 10$: CMPB 1(R11), #^A"E" ;Header must say "EDX" BNEQ 18$ CMPB 2(R11), #^A"D" BNEQ 18$ CMPB 3(R11), #^A"X" BNEQ 18$ CMPB (R11), #2 ;version number must be 2 BEQL 20$ MOVZBL 3(R11),-(SP) ;version number PUSHL #1 ;one FAO argument PUSHL #EDX__DICVERSERR ;error in dictionary version number CALLS #3,EDX_SIGNAL ;signal error MOVL #EDX__DICVERSERR,R0 ;set return status RET 18$: PUSHL DICFABIO+FAB$L_FNA ;filename addresss MOVZBL DICFABIO+FAB$B_FNS,-(SP) ;filename size PUSHL #2 ;2 FAO args PUSHL #EDX__DICHEADERR ;error in dictionary header CALLS #4,EDX_SIGNAL ;signal error MOVL #EDX__DICHEADERR,R0 ;set return status RET ;MAP LEXICAL DATABASE INTO MEMORY 20$: $CLOSE FAB=DICFABIO ;close it for I/O $OPEN FAB=DICFABMAP ;open it for mapping BLBC R0,22$ ;branch if error ;Calculate length in blocks of lexical database + index + common words DIVL3 #BLOCK_SIZE,DIC_CWDLEN(R11),R0 INCL R0 ;R0 = number of blocks for common words SUBL3 DIC_LEXVBN(R11),DIC_CWDVBN(R11),R2 ;R1 = number of blocks for lexical database + index ADDL2 R2,R0 ;R1 = number of blocks for lexical database + index + common words $CRMPSC_S - ;map the lexical database straight into memory INADR=MAPRANGE,- RETADR=LEXDBA,- VBN=DIC_LEXVBN(R11),- PAGCNT=R1,- FLAGS=#SEC$M_EXPREG,- CHAN=DICFABMAP+FAB$L_STV,- PFC=DIC_INDPLN(R11) BLBS R0,30$ 22$: PUSHL #0 ;0 FAO args PUSHL R0 ;Error status PUSHAL BELL ;Ring terminal bell CALLS #1,G^LIB$PUT_OUTPUT ; PUSHL #0 ;2 FAO args PUSHL #EDX__ERRMAPDIC ;error mapping dictionary file message CALLS #4,EDX_SIGNAL ;signal message MOVL #EDX__ERRMAPDIC,R0 ;set return status RET ;SET POINTERS TO INDEX, COMMON WORDS, LEXICAL DATABASE. 30$: MULL2 #BLOCK_SIZE,R2 ADDL3 R2,LEXDBA,DIC_CMNWDS ;dic_cmnwds = lexdba+ (dic_cwdvbn - dic_lexvbn)*BLOCK_SIZE SUBL3 DIC_LEXVBN(R11),DIC_INDVBN(R11),R0 ;dic_index = lexdba+ (dic_indvbn-dic_lexvbn)*BLOCK_SIZE MULL2 #BLOCK_SIZE,R0 ADDL3 R0,LEXDBA,DIC_INDEX ;OPEN AND READ IN THE USER'S PERSONAL DICTIONARY FILE 40$: $OPEN FAB=PERSDICFAB ;Open user's personal dictionary file BLBC R0,42$ ;branch if error $CONNECT RAB=PERSDICRAB ;Connect to input BLBS R0,43$ ;branch if OK 42$: ;error processing would go here CMPL R0,#RMS$_FNF ;compare with file not found BEQL 100$ PUSHL #0 ;0 FAO args PUSHL R0 ;RMS error PUSHL PERSDICFAB+FAB$L_FNA ;filename address MOVZBL PERSDICFAB+FAB$B_FNS,-(SP) ;filename size PUSHL #2 ;2 FAO args PUSHL #EDX__PERSDICERR ;error opening personal dictionary CALLS #6,EDX_SIGNAL ;signal message BRB 100$ ;and jump to end 43$: SUBL2 #8,SP ;build string descriptor for MOVL SP,R9 ; WDBUF string buffer. MOVB #DSC$K_DTYPE_T, DSC$B_DTYPE(R9) ;Fill in Type MOVB #DSC$K_CLASS_S, DSC$B_CLASS(R9) ;Fill in Class MOVAB WDBUF, DSC$A_POINTER(R9) ;Fill in address MOVAB PERSDICRAB,R10 50$: $GET RAB=PERSDICRAB ;LOOP READ IN ALL WORDS BLBC R0,100$ ;expect End Of File error MOVW RAB$W_RSZ(R10),DSC$W_LENGTH(R9) ;length of line PUSHL R9 ;address of descriptor CALLS #1,SPELL_TEXTLINE ;this trims, upcases, and sets word for inclusion in accepted word tree CALLS #0,SPELL_ACCEPT_WORD ;add word to accepted word list BRB 50$ ;loop 100$: $CLOSE FAB=PERSDICFAB ;close file (ignore error if we get one) MOVL #SS$_NORMAL,R0 ;initialization successfull RET ;------------------------------------------------------------------------------ .SUBTITLE SPELL_TEXTLINE ;++ ; ; Functional Description: ; Checks the spelling of each word in the input string ; ; Calling Sequence: ; CALLS #1,SPELL_TEXTLINE ; ; Argument inputs: ; 4(AP) address of descriptor of string containing words to check ; (usually INSTR) ; ; Outputs: ; LIB$_NORMAL if all words in line spelled correctly ; LIB$_NOTFOU if a word in line was spelled incorrectly ; OUTSTR = characters 1-9 is return status value ; characters 10-12 is decimal value of offset from start of ; instr where misspelled word begins ; character 13 is space character ; characters 14-16 is decimal value of length of misspelled ; word. ; ; Outline: ; 1. Memory is allocated on the stack ; ; 2. The next word in INSTR is parsed off ; a. INSTR is searched for the start of a word. The start of a ; word is any character {A...Z,a...z}. ; b. INSTR is searched for the end of a word. The end of a word ; is any character other than {A...Z,a...z} and the appostrophie ; ("'") character. A special check is made to handle the ; appostrophie. Words line "we're" or "you'd" are accepted ; as is. Words which have a trailing "'s" such as "Mark's" or ; "Saturday's" have the "'s" trimmed off. We ignore quotes ; which occur at the end of a word with no letters following. ; ; When a single quote character "'" is encountered: ; i. If we are at the end of the line, the quote is rejected. ; ii. If the next character following the quote is not a ; letter (A-Z,a-z), the quote is rejected. ; iii. If the next character following the quote is a "S" ; or a "s", ; ; 3. A dictionary lookup search is made for a match to the resulting ; parsed off word. ; ; 4. Loop back to step 2 until all words in INSTR have been checked. ; ; ; Memory Map (Memory allocated on stack): ; -----------------------------------------(descriptor for FAO call) ; | class | dtype | string length | (R2) ; ----------------------------------------- ; | buffer address | ; -----------------------------------------(descriptor for STR$UPCASE call) ; | class | dtype | string length | ; ----------------------------------------- ; | buffer address | ; -----------------------------------------(return string buffer for FAO call) ; | FAO BUFFER | (R3) ; | . | ; | . | ; | | ; -----------------------------------------(base address stored in R11) ; | OFFSET | <^x00> ; ----------------------------------------- ; | WORD_START | <^x04> ; ----------------------------------------- ; | WORD_LENGTH | <^x08> ; ----------------------------------------- ; | <+^x0C> OFFSET = ^x00 WORD_START = ^x04 WORD_LENGTH = ^x08 ;R9 = textline length (word) (instr descriptor length, type, class) ;R10 = textline address ;R11 = address of local memory .PSECT DATA RD,WRT,NOEXE,LONG,PIC,NOSHR .ALIGN LONG FAOSPLOUT: .ASCID /!3UL !3UL/ SPLOUTLEN=7 .PSECT CODE NOWRT,EXE,PIC,LONG,SHR .ENTRY SPELL_TEXTLINE,^M<R2,R3,R9,R10,R11> SUBL2 #^x0C,SP ;allocate local memory MOVL SP,R11 ;save address of local memory CLRL OFFSET(R11) ;offset=0 MOVQ @4(AP),R9 ;descriptor. length -> R9, address -> R10 ;SEARCH FOR START OF WORD 1$: CMPW OFFSET(R11),R9 ;check for end of line BLSS 3$ ;branch if not end of line PUSHL #LIB$_NORMAL CALLS #1,FMTOUTSTR ;set return status RET ;All done. No more words to check on this line 3$: MOVAB @OFFSET(R11)[R10],R1 MOVZBL @OFFSET(R11)[R10],R0 CMPB @OFFSET(R11)[R10], #^A"A" ;if char ={A..Z,a..z} then exitloop, start of word found BLSS 9$ ;char < A, char not a letter CMPB @OFFSET(R11)[R10], #^A"Z" ; BLEQ 10$ ;matches A..Z CMPB @OFFSET(R11)[R10], #^A"a" ;try a..z BLSS 9$ ;no match, loop again (char < z & char > Z) CMPB @OFFSET(R11)[R10], #^A"z" ; BLEQ 10$ ;matches a..z 9$: INCL OFFSET(R11) ;move to next character BRB 1$ ;SEARCH FOR END OF WORD ;OFFSET now at start of word, find end of word. 10$: MOVL OFFSET(R11),WORD_START(R11) ;save word start offset 11$: INCL OFFSET(R11) ;move to next character CMPW OFFSET(R11),R9 ;check for end of line BLSS 50$ ;not end of line, continue BRW 200$ ;end of line. Exitloop, word found 50$: CMPB @OFFSET(R11)[R10], #^A"'" ;check for appostrophie BNEQ 150$ ;branch if not an appostrophie to normal checking ; HANDLE APOSTROPHE INCL OFFSET(R11) ;move to next character CMPW OFFSET(R11),R9 ;check for end of line BGEQ 100$ ;end of line, reject "'" ; Check that next char after apostrophe is a letter CMPB @OFFSET(R11)[R10], #^A"A" ;if char ={A..Z,a..z} then exitloop, start of word found BLSS 100$ ;char < A, char not a letter, reject "'" CMPB @OFFSET(R11)[R10], #^A"Z" ; BLEQ 80$ ;matches A..Z, continue. CMPB @OFFSET(R11)[R10], #^A"a" ;try a..z BLSS 100$ ;char not a letter, reject "'" CMPB @OFFSET(R11)[R10], #^A"z" ; BGTR 100$ ;char not a letter, reject "'" ; char was a letter. Now check if letter was S (as in 's) 80$: CMPB @OFFSET(R11)[R10], #^A"S" ;check for "'s" BEQL 100$ ; 90$: CMPB @OFFSET(R11)[R10], #^A"s" ; BNEQ 11$ ;not "'s", accept appostrophie and continue 100$: DECL OFFSET(R11) SUBL3 WORD_START(R11), OFFSET(R11),- WORD_LENGTH(R11) ;Reject "'". Remove "'" and declare end of word ADDL2 #2,OFFSET(R11) ;set offset beyond end of current word BRB 201$ ;(skip setting offset for next word) ; NORMAL CHECK FOR CHAR <> LETTER 150$: CMPB @OFFSET(R11)[R10], #^A"A" ;if char ={A..Z,a..z} then exitloop, start of word found BLSS 200$ ;char < A, char not a letter, reject "'" CMPB @OFFSET(R11)[R10], #^A"Z" ; BLEQ 160$ ;matches A..Z, continue. CMPB @OFFSET(R11)[R10], #^A"a" ;try a..z BLSS 200$ ;char not a letter, reject "'" CMPB @OFFSET(R11)[R10], #^A"z" ; BGTR 200$ ;char not a letter, reject "'" 160$: BRW 11$ ;continue loop 200$: SUBL3 WORD_START(R11), OFFSET(R11),- ;end of line, set word length WORD_LENGTH(R11) ; 201$: PUSHAB @WORD_START(R11)[R10] ;address of word start PUSHL WORD_LENGTH(R11) ;Length of word CALLS #2,DIC_LOOKUP_WORD ;see if word is in dictionary BLBC R0,210$ ;branch if word not found BRW 1$ ;start again searching for next word in line ;FOUND MISSPELLED WORD 210$: MOVL R0,R9 ;Status from DIC_LOOKUP_WORD TSTL DIC_LWA ;check for previous misspelled word to deallocate BEQL 211$ ;branch if no previous word to deallocate PUSHAL VM_ZONE ;Our virtual memory zone id PUSHAL DIC_LWA ;Address of address of memory block to deallocate PUSHAL DIC_LWL ;Address containing length of memory to deallocate CALLS #3,G^LIB$FREE_VM ;Deallocate memory used for new FAB block 211$: PUSHAL VM_ZONE ;Our virtual memory zone id PUSHAL DIC_LWA ;Address to place return address of memory block allocated PUSHAL WORD_LENGTH(R11) ;Address containing length of memory to allocate CALLS #3,G^LIB$GET_VM ;Allocate memory for new block in linked list MOVC3 WORD_LENGTH(R11),- ;Copy word to storage @WORD_START(R11)[R10],- @DIC_LWA MOVL WORD_LENGTH(R11),DIC_LWL ;save word length SUBL2 #4,SP ;upcase stored word MOVW DIC_LWL, DSC$W_LENGTH(SP) ;Length MOVB #DSC$K_DTYPE_T, DSC$B_DTYPE(SP) ;Type MOVB #DSC$K_CLASS_S, DSC$B_CLASS(SP) ;Class MOVL DIC_LWA, DSC$A_POINTER(SP) ;Address PUSHAL (SP) ;src-str (descriptor) PUSHAL 4(SP) ;dst_str (descriptor, same) CALLS #2,G^STR$UPCASE ;upcase misspelled word for storage MOVB #1,GMODE ;reset guess mode pointers MOVB #1,GSUBMODE MOVB #1,GCOL SUBL2 #<SPLOUTLEN+8>,SP ;Build temp descriptor MOVL SP,R2 ;Save address of descriptor in R2 PUSHL R0 ;save status from DIC_LOOKUP_WORD MOVW #SPLOUTLEN, DSC$W_LENGTH(R2);Length of output FAO string MOVB #DSC$K_DTYPE_T, DSC$B_DTYPE(R2) ;Descriptor type MOVB #DSC$K_CLASS_S, DSC$B_CLASS(R2) ;Descriptor Class MOVAB 8(R2),R3 ;base address MOVL R3,DSC$A_POINTER(R2) ;base address PUSHL WORD_LENGTH(R11) ;length of misspelled word PUSHL WORD_START(R11) ;starting offset of misspelled word PUSHL R2 ;Outbuf (by descriptor) PUSHL #0 ;Outlen (not used) PUSHAQ FAOSPLOUT ;Ctrstr (by descriptor) CALLS #5,G^SYS$FAO ;Write size to outline PUSHL R3 ;address of output string PUSHL #SPLOUTLEN ;length of output string PUSHL R9 ;status from DIC_LOOKUP_WORD CALLS #3,FMTOUTSTR RET ;------------------------------------------------------------------------------ .SUBTITLE DIC_LOOKUP_WORD ;++ ; ; Functional Description: ; Searches the EDX dictionary for a given word ; ; Calling Sequence: ; CALLS #2,DIC_LOOKUP_WORD ; ; Argument inputs: ; (AP) - number of arguments (#2 by value) ; 4(AP) - length of word to search for (word, by value) ; 8(AP) - starting address of word ; (A string descriptor may be used for the two arguments) ; ; Outputs: ; R0 = LIB$_NORMAL - word was found ; = LIB$_NOTFOU - word was not found ; ; Outline: ; 1. The input word is trimmed, upcased, and copied ; to a target_word buffer with a leading and trailing ; space appended. ; ; 2. The dictionary common word list is searched for the word. ; ; 3. The main lexical database is searched for the word. ; ; 4. The list of accepted words is searched for a match. ; ; ; Memory Map (Memory allocated on stack): ; -----------------------------------------(temp descriptor for input word) ; | class | dtype | length | ; ----------------------------------------- ; | input word address | ; -----------------------------------------(descriptor for target_word buffer+1 ; | class | dtype | length | (R8) ; ----------------------------------------- ; | target_word buffer address | ; ----------------------------------------- ; | TARGET_WORD BUFFER | (R9) (R5=R9+1) ; | . | ; | . | ; ----------------------------------------- ; |(original stack pinter) ; ;Registar usage: ; R11 = DIC_HEADER starting address ; R10 = DIC_INDEX starting address ; R9 = address of upcased target word with leading and trailing space ;(R8) - low word = length of upcased target word including leading and trailing space ;-- .PSECT DATA RD,WRT,NOEXE,LONG,PIC,NOSHR TARGET_WORD_LEN: .BLKL 1 TARGET_WORD_A: .BLKL 1 ASSUME TARGET_WORD_LEN+4 EQUAL TARGET_WORD_A ;TARGET_WORD_LEN + TARGET_WORD_A form descriptor .PSECT CODE NOWRT,EXE,PIC,LONG,SHR .ENTRY DIC_LOOKUP_WORD,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11> ;; MOVB #DSC$K_DTYPE_T,<^x06>(AP) ;debug ;; MOVB #DSC$K_CLASS_S,<^x07>(AP) ;debug ;; PUSHAQ 4(AP) ;debug ;; CALLS #1,G^LIB$PUT_OUTPUT ;debug BSBW SETUP_DICWORD ;copy word over to local storage with leading and trailing blank CMPL #2,(R8) ;Check for zero length word (two spaces) BNEQ 2$ MOVL #LIB$_NORMAL,R0 ;accept zero length word as OK RET ;SEARCH COMMON WORD LIST FOR MATCH 2$: MOVL DIC_HEADER,R11 MATCHC (R8),(R9),DIC_CWDLEN(R11),@DIC_CMNWDS ;Find match to target_string in common word list BNEQ 50$ BRW 100$ ;word found 50$: MOVL R9,TARGET_WORD_A ;save target_word address MOVZWL (R8),TARGET_WORD_LEN ;save target_word length ADDL3 #1,R9,R5 ;address of target guide word BSBW BINSRCH_MAINDIC ;do binary search of index MOVL LEXDBA,R9 ;lexical database address MATCHC TARGET_WORD_LEN,- @TARGET_WORD_A,- R5, (R9)[R4] ;Find match to target_string in dictionary pages BNEQ 90$ 100$: MOVL #LIB$_NORMAL,R0 ;word found RET ;SEARCH ACCEPTED WORD LIST FOR MATCH 90$: SUBL2 #2,TARGET_WORD_LEN ;don't count leading and trailing blanks INCL TARGET_WORD_A ;move over first blank PUSHAL NEWNODE ;new node return address PUSHAB COMPARE_NODE ;compare node routine PUSHAQ TARGET_WORD_LEN ;our word to search for (descriptor) PUSHAL TREE_HEAD ;tree head for the binary tree CALLS #4,G^LIB$LOOKUP_TREE ;search for the word BLBS R0,100$ ;word found MOVL #LIB$_NOTFOU,R0 ;word not found RET ;------------------------------------------------------------------------------ .SUBTITLE SETUP_DICWORD ;++ ; ; Functional Description: ; Copies input word to local storage, upcases, trims, adds leading ; and trailing space. ; ; Calling Sequence: ; JSB SETUP_DICWORD ; ; Inputs: ; 4(AP) - length of word to search for (word, by value) ; 8(AP) - starting address of word ; (A string descriptor may be used for the two arguments) ; ; Outputs: ; R0 - destroyed ; R1 - destroyed ; R8 - Low word is length of resulting word incliding leading and ; trailing space. ; R9 - Address of word starting with leading space. ; R11 - destroyed ; ; Side effects: ; Allocates space on stack for resulting word ; ; Outline: ; 1. A buffer is allocated on the stack. The buffer is of length ; DIC_INDSWD + 2, then the stack os longword aligned. ; ; 2. A temporary descriptor is built on the stack for the new ; buffer. ; ; 3. A temporary descriptor is built on the stack for the input ; string. (This to insure we have the type and calss fields ; filled in). ; ; 4. The input word is trimmed by STR$TRIM and copied over to the ; new buffer on the stack. ; ; 5. The word on the buffer is upcased by STR$UPCASE. ; ; 6. The leading and trailing space characters are added. ; ; Memory Map (Memory allocated on stack): ; -----------------------------------------(temp descriptor for input word) ; | class | dtype | length | ; ----------------------------------------- ; | input word address | ; -----------------------------------------(descriptor for target_word buffer+1 ; | class | dtype | length | (R8) ; ----------------------------------------- ; | target_word buffer address | ; ----------------------------------------- ; | TARGET_WORD BUFFER | (R9) (R5=R9+1) ; | . | ; | . | ; ----------------------------------------- ; |(original stack pinter) ; ;-- SETUP_DICWORD: ;TRIM WORD, UPCASE, ADD LEADING AND TRAILING BLANK MOVL SP,R0 ;save original SP MOVL R0,R11 ;Save return address ptr MOVZWL 4(AP),R1 ;length of word SUBL2 R1,SP ;allocate space for word MOVL DIC_HEADER,R1 SUBL2 DIC_INDSWD(R1),SP ;insure long enough for guide word SUBL2 #2,SP ;more space for leading and trailing blanks BICB2 #^B0011,SP ;longword align stack pointer MOVL SP,R9 ;R9 = address of target_word buffer SUBL2 SP,R0 ;R0 = total length of target_word buffer SUBL2 #8,SP ;allocate space for descriptor MOVL SP,R8 ;address of descriptor for target_word buffer+1 SUBW3 #1,R0, DSC$W_LENGTH(SP) ;build descriptor for target_word MOVB #DSC$K_DTYPE_T, DSC$B_DTYPE(SP) ;Type MOVB #DSC$K_CLASS_S, DSC$B_CLASS(SP) ;Class ADDL3 #1,R9, DSC$A_POINTER(SP) ;address SUBL2 #8,SP ;allocate space for descriptor MOVL SP,R0 ;address of descriptor MOVW 4(AP), DSC$W_LENGTH(SP) ;length MOVB #DSC$K_DTYPE_T, DSC$B_DTYPE(SP) ;Type MOVB #DSC$K_CLASS_S, DSC$B_CLASS(SP) ;Class MOVL 8(AP), DSC$A_POINTER(SP) ;address PUSHAW (R8) ;out-len (word, by reference) PUSHL R0 ;src-str (address of descriptor) PUSHL R8 ;dst-str (address of descriptor of target_word buffer+1) CALLS #3,G^STR$TRIM ;copy in-word to target_word buffer and get trimmed length 2$: PUSHL R8 ;src-str (address of descriptor for target_word buffer+1) PUSHL R8 ;dst-str (same place) CALLS #2,G^STR$UPCASE ;upcase target_word ;ADD LEADING AND TRAILING SPACES MOVB #SPACE,(R9) ;add leading space ADDW2 #2,(R8) ;adjust length to include leading and trailing spaces MOVZWL (R8),R0 ;convert length to longword MOVB #SPACE,(R9)[R0] ;add trailing space JMP @(R11) ;our equivalent of returning ;------------------------------------------------------------------------------ .SUBTITLE BINSRCH_MAINDIC ;++ ; ; Functional Description: ; Performs the binary search on the index to the main lexical database ; ; Calling Sequence: ; JSB BINSRCH_MAINDIC ; ; Inputs: ; R5 = Address of target guide word (at least of length DIC_INDSWD) ; ; Outputs: ; R4 = offset in bytes from start of lexical database to page R6 (i.e. start search here) ; R5 = length in bytes between page R6 and page R8 including page R8 (i.e. length to search starting at R4) ; R6 = low boundary dictionary page number ; R7 = offset of last guide word entry in dictionary index ; R8 = high boundary dictionary page number ; R9 = offset of guide word entry in dictionary index for page R8 ; R11 = DIC_HEADER ; R10 = DIC_INDEX ; ; Side effects: ; Alters registers R4 - R9 ; Registers R11, R10 must have address of DIC_HEADER, DIC_INDEX ; ; Outline: ; 1. A binary search is performed on the guide word index to ; the lexical database. ; 2. A linear search is then performed to determine the ; upper and lower dictionary lecixal database page boundaries ; wherein the word must lie. This step is necessary because ; the format of the guide word index allows for multiple ; occurances of the same guide word. (The guide word, being ; the first n characters of the first word on a lexical database ; page, may be a very common word beginning and more than one ; lexical database page may have the same guide word). ; ;-- ;BINARY SEARCH LOOP. ; R11 = DIC_HEADER ; R10 = DIC_INDEX ; R9 = byte offset into index block (=R8*index_word_size) ; R8 = test page number offset ; R7 = high boundary dictionary page number offset ; R6 = low boundary dictionary page number offset ; R5 = address of target guide word (=target_word buffer+1) BINSRCH_MAINDIC: MOVL DIC_HEADER,R11 MOVL DIC_INDEX,R10 CLRL R6 ;prepare for binary search. R6=low_boundary MOVL DIC_INDLEN(R11),R7 ;index_length/index_word_size=number_of_pages DIVL2 DIC_INDSWD(R11),R7 ;R7=last page number (high_boundary) DECL R7 ;R7=maximum page offset 51$: ADDL3 R6,R7,R8 ;new=(low+high)/2 DIVL2 #2,R8 CMPL R6,R8 ;exitloop when guess=lowb BEQL 53$ MULL3 DIC_INDSWD(R11),R8,R9 ;R9=new*index-word-size CMPC3 DIC_INDSWD(R11),(R10)[R9],(R5) ;DO THE COMPARE BEQL 53$ ;guess = target_index. Switch to linear search. BLSS 52$ ;guess < target_index. MOVL R8,R7 ;guess > target_index. BRB 51$ 52$: MOVL R8,R6 BRB 51$ ; Now do linear search up and down to find true page boundaries ; within which the word must lie. ; R8 = starting page number ; Check for R8 < target_index. Also test for R8 = beginning of dictionary (the " A " test) ; Move toward A's until R8 < target index and set R6 as lower bound ; then move toward Z's until R8 > target_index and leave R8 at upper bound 53$: MULL3 DIC_INDSWD(R11),R8,R9 ;R9=new*index-word-size CMPC3 DIC_INDSWD(R11),(R10)[R9],(R5) ;DO THE COMPARE BLSS 70$ ;found R8 < target_index TSTL R8 ;test for R8 = 0 BEQL 70$ ;R8 = 0 beginning of dictionary DECL R8 ;go back a page BGTR 53$ ;loop while R8 > 0 and > target_index BRB 80$ ;exitloop if R8 index = 0 (or -1 if was 0 before DECL) ;Now look toward Z's for R8 > target_index ;R7 becomes offset of last guide word entry in dictionary ;R8 becomes high boundary page offset 70$: MOVL R8,R6 ;Set R6=lowb SUBL3 DIC_INDSWD(R11),DIC_INDLEN(R11),R7 ;R7=offset of last guide word entry in dictionary index 71$: INCL R8 ;Start searching towards Z's for guess > target_index MULL3 DIC_INDSWD(R11),R8,R9 ;R9=new*index-word-size CMPL R9,R7 ;check for R9 = last index entry (can't go any higher) BGEQ 80$ ;accept if last page in dictionary CMPC3 DIC_INDSWD(R11),(R10)[R9],(R5) ;DO THE COMPARE BGTR 80$ ;found R8 < target_index BRB 71$ ;Register usage ; R4 - becomes offset in bytes from start of lexical database to page R8 ; R5 = becomes length in bytes between page R6 and page R8 including page R8 to search ; R6 = low boundary dictionary page number ; R8 = high boundary dictionary page number 80$: SUBL3 R6,R8,R5 ;R5 = number of pages INCL R5 ;include R8 page MULL2 DIC_INDPLN(R11),R5 ;R5 = number of bytes to search MULL3 DIC_INDPLN(R11),R6,R4 ;R4 = offset in bytes from start of lexical database to page R6 (high boundary page) RSB ;------------------------------------------------------------------------------ .SUBTITLE DIC_BROWSE ;++ ; ; Functional Description: ; Returns words from the dictionary for EDX to display in it's ; dictionary lookup buffer. This routine returns in OUSTSTR a ; very long string of length ROWS x COLUMNS which is to be broken ; up by EDX into pieces of length COLUMNS and displayed. ; ; We either do a lookup best match to given word, a display next ; page, or a display previous page, depending upon the value of R6. ; ; Calling Sequence: ; CALLS #0,DIC_BROWSE ; ; Argument inputs: ; ....v....1....v....2....v....3....v....4....v....5....v....6... ; INSTR - "yyyyyyyyzzzzzzzzwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww... ; where yyyyyyyy is ascii for a hex longword indicating ; the number of rows in the DIC window to fill ; and zzzzzzzz is ascii for a hex longword indicating ; the number of columns in the DIC window to fill ; and wwwwwwwwwwww... is the word to best match if ; we are not doing a prev_page or next_page display. ; ; Implicit inputs: ; R6 - 1 display previous page ; 2 do best match word and display page ; 3 display next page ; ; Outputs: ; OUTSTR - a string of length ROWS x COLUMNS (yyyyyyyy x zzzzzzzz) ; containing all the best match words in alphabetical order ; and arranged so that the first n characters is to be put ; as row 1, the next n characters as row 2, etc... ; ; For typical values of 10 ROWS and 80 COLUMNS the output is displayed ; as 4 columns, each word a maximum length of 19 characters else ; the word overflows into the next column. ; ; Example final output display: ; ; word1 word11 word21 word31 ; word2 word12 word22 word32 ; word3 word13 word23 word33 ; word4 word14 word24 word34 ; word5 word15 word25 word35 ; word6 word16 word26 word36 ; word7 word17 word27 word37 ; word8 word18 word28 word38 ; word9 word19 word29 word39 ; word10 word20 word30 word40 ; ; The above typical example has 4 word columns and 10 rows. ; In the above example we'd try to make our best fit word word21. ; ; Implicit: ; Pointers DICPTRA and DICPTRZ are set. DICPTRZ points to the ; space character following the last word in the lexical database ; displayed on the screen. DICPTRA points to the space character ; preceeding the first word in the lexical database displayed. ; These pointers are used if the user requests to see the next ; or previous screen full of words in the dictionary. ; ; Outline: ; 1. INSTR is parsed, yyyyyyyy, zzzzzzzz, are converted to integers. ; 2. Depending on R6 we either call dic_browse_prev_page, ; dic_browse_word, or dic_browse_next_page (which is just calling ; dic_browse_fill passing it DICPTRZ) ; ; Memory Map: ; The value of yyyyyyyy is left on the stack by the first call to ; LIB$CVT_HTB. The value of zzzzzzzz is left on the stack by the ; second call to LIB$CVT_HTB. ; ; MEMORY BUILT ON STACK: ; -----------------------------------------(descriptor for word to best match) ; | | string length | pushed on stack if R6 specifies DIC_BROWSE_WORD ; ----------------------------------------- ; | string address | ; ----------------------------------------- ; | number of columns | value of zzzzzzzz ; ----------------------------------------- ; | number of rows | value of yyyyyyyy ; -----------------------------------------(R8) ; | <-- original SP ; ;-- .PSECT DATA RD,WRT,NOEXE,LONG,PIC,NOSHR DICPTRA: .BLKL 1 DICPTRZ: .BLKL 1 WORD_COLUMN_LENGTH=20 .MACRO CHECK_STATUS,?DEST BLBS R0,DEST PUSHL R0 ;save R0 status PUSHL R0 CALLS #1,EDX_SIGNAL POPL R0 ;restore R0 status DEST: .ENDM CHECK_STATUS .PSECT CODE NOWRT,EXE,PIC,LONG,SHR .ENTRY DIC_BROWSE,^M<R2> MOVL INSTR,R2 ;address of instr descriptor MOVL 4(R2),R2 ;address of instr string PUSHL #0 ;place for result PUSHL SP ;address of place for result PUSHL R2 ;address of instr string PUSHL #8 ;length of hex longword CALLS #3,G^LIB$CVT_HTB ;convert ascii hex to binary CHECK_STATUS ADDL2 #8,R2 ;address of instr+8 (for zzzzzzzz columns) PUSHL #0 ;place for result PUSHL SP ;address of place for result PUSHL R2 ;address of instr string PUSHL #8 ;length of hex longword CALLS #3,G^LIB$CVT_HTB ;convert ascii hex to binary CHECK_STATUS ;SP now points to number of columns CASEB R6, #1, #<3-1> ;Case wether to do lookup word, prev page, or next page 1$: .WORD 10$-1$,- ; 1 = display prev page 20$-1$,- ; 2 = Use wwwwwwwwwww... word in INSTR 30$-1$ ; 3 = display next page MOVL #EDX__UNKNCODE,R0 ;Put error status in R0 ; JSB ERR ;Signal error RET ;and return with error status in R0 10$: CALLS #2,DIC_BROWSE_PREV_PAGE RET 20$: ADDL3 #8,R2,-(SP) ;address of instr+16 (wwwwwwwwwwwwwww... word) MOVZWL @INSTR,R0 ;length of instr SUBL3 #16,R0,-(SP) ;length - 16 for xxxxxxxxyyyyyyyyzzzzzzzz CALLS #4,DIC_BROWSE_WORD RET 30$: PUSHL DICPTRZ ;(dic_browse_next_page) CALLS #3,DIC_BROWSE_FILL RET ;------------------------------------------------------------------------------ .SUBTITLE DIC_BROWSE_PREV_PAGE ;++ ; ; Functional Description: ; Starting at DICPTRA, counts backwards an appropriate number of ; words, and calls dic_browse_fill to do the rest given the starting ; point. ; ; Argument inputs: ; (AP) = 2 four arugments ; 4(AP) = nchars - number of characters across window display (width) ; 8(AP) = nrows - number of rows in window display to fill (height) ; ; Outline: ; 1. Count backwards N words. In the above example these words will ; occupy word31 - word40, the right most column. N = nrows+1. ; ; 2. Count backwards M more words. In the above example these words ; will occupy word1 - word30. In general M is the number of words ; necessary to fill all the previous columns we have. M is ; calculated as follows: ; M = ( total_number_of_word_columns - 1 ) * nrows ( if M < 0 then M = 0 ) ; ; where total_number_of_word_columns = INT( nchars / WORD_COLUMN_LENGTH ) ; where nchars = 4(AP) ; ; If a word is longer than WORD_COLUMN_LENGTH-1, then we count it ; as two words. For example, in the above example if word3 were ; longer than WORD_COLUMN_LENGTH-1, it would spill into the column ; for word13. Thus this word effectively takes up two word spaces. ; ;-- .PSECT CODE NOWRT,EXE,PIC,LONG,SHR .ENTRY DIC_BROWSE_PREV_PAGE,^M<R3,R8> ; Step 1. Count N words backwards not looking at word length MOVL DICPTRA,R3 MOVL 8(AP),R8 ;R8 = nrows INCL R8 ;R8 = nrows+1 = N, number of words to count backwards 101$: DECL R3 ;pointer into dictionary CMPL R3,LEXDBA ;check for at beginning of dictionary BLEQ 121$ ;at beginning of dictionary 103$: CMPB (R3),#SPACE ;check for space BEQL 110$ ;found the space DECL R3 ;pointer BRB 103$ ;loop 110$: SOBGTR R8,101$ ;loop until we cover R8 number of words ; Step 2. ; Count M words backwards looking at word length ; if word length >= word_column_length-1 then count as two words ; nchars = 4(AP) ; total_number_of_word_columns = INT( nchars / WORD_COLUMN_LENGTH ) ; M = ( total_number_of_word_columns - 1 ) * nrows ; R8 = M DIVL3 #WORD_COLUMN_LENGTH,4(AP),R8 ;R8 = total number of word columns DECL R8 ;R8 = ( total number of word columns - 1 ) MULL2 8(AP),R8 ;R8 = M = ( total number of word columns - 1 )*nrows INCL R8 ;R8 = M+1 (will be decremented by SOBGTR) BRB 120$ ;enter loop 111$: DECL R3 ;pointer into dictionary CMPL R3,LEXDBA ;check for at beginning of dictionary BLEQ 121$ ;at beginning of dictionary CLRL R0 ;counter of word length 113$: CMPB (R3),#SPACE ;check for space BEQL 120$ ;found the space DECL R3 ;pointer INCL R0 ;word length CMPL R0,#<WORD_COLUMN_LENGTH-1> ;see if word is longer than 19 chars BNEQ 113$ ;loop (if word < 19) DECL R8 ;count as word (word longer than 19) CLRL R0 ;reset word length BRB 113$ ;loop 120$: SOBGTR R8,111$ ;loop until we cover R8 number of words 121$: PUSHL 8(AP) ;nrows PUSHL 4(AP) ;nchars INCL R3 ;point to first char of first word PUSHL R3 ;Pointer into dictionary CALLS #3,DIC_BROWSE_FILL RET ;------------------------------------------------------------------------------ .SUBTITLE DIC_BROWSE_WORD ;++ ; ; Functional Description: ; Accepts a word defined by 4(AP),8(AP). Searches in the dictionary ; for the best match to the given word. Counts backwards an ; appropriate number of words, and calls dic_browse_fill to ; do the rest given the starting point. ; ; Argument inputs: ; (AP) = 4 four arugments ; 4(AP) = length of string containing word to best match (low word, high word is ignored) ; 8(AP) = address of string containing word to best match ; 12(AP) = nchars - number of characters across window display (width) ; 16(AP) = nrows - number of rows in window display to fill (height) ; ; Outline: ; 1. The given word is copied over to local storage, a leading space ; is added, and it is blank padded to DIC_INDSWD + 1 in length. ; ; 2. The index to the dictionary main lexical database is searched ; to determine the page range within which the word must lie if ; it exists. ; ; 3. Search range of dictionary pages for match to word. If no match ; found search again for word(1:length-1). If no match found search ; for word(1:length-2), and so on until we reach search for word(1:1), ; which is a space character. (If we can't find a single space ; character somethings really wrong.) ; ; 4. Find best match word. Search forwards until ; current_word > target_word. ; ; 4. Count backwards N words. In the example given in DIC_BROWSE, ; these words will occupy word11 - word20, the second column. ; N = nrows+1. ; ; 5. Count backwards M more words. In the above example these words ; will occupy word1 - word10. In general M is the number of words ; necessary to fill all the previous columns we have. M is ; calculated as follows: ; M = ( INT( total_number_of_word_columns / 2 ) - 1 ) * nrows ( if M < 0 then M = 0 ) ; ; where total_number_of_word_columns = INT( nchars / WORD_COLUMN_LENGTH ) ; where nchars = 12(AP) ; ; If a word is longer than WORD_COLUMN_LENGTH-1, then we count it ; as two words. For example, in the above example if word3 were ; longer than WORD_COLUMN_LENGTH-1, it would spill into the column ; for word13. Thus this word effectively takes up two word spaces. ; ; ; MEMORY ALLOCATED ON STACK: ; ; ----------------------------------------- ; | OUTSTR BUFFER | (R10) ; | . | ; | . | ; | . | ; | . | ; | . | ; ----------------------------------------- ; ;-- .PSECT CODE NOWRT,EXE,PIC,LONG,SHR .ENTRY DIC_BROWSE_WORD,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11> ;; MOVB #DSC$K_DTYPE_T,<^x06>(AP) ;debug print word to match ;; MOVB #DSC$K_CLASS_S,<^x07>(AP) ;debug ;; PUSHAQ 4(AP) ;debug ;; CALLS #1,G^LIB$PUT_OUTPUT ;debug ; Steps 1,2. BSBW SETUP_DICWORD ;copy word over to local storage with leading and trailing blank MOVL R9,TARGET_WORD_A ;save target_word address MOVZWL (R8),TARGET_WORD_LEN ;save target_word length ADDL3 #1,R9,R5 ;address of target guide word BSBW BINSRCH_MAINDIC ;do binary search of index ; Step 3. ;Find best match word MOVL LEXDBA,R9 ;lexical database address MOVL TARGET_WORD_LEN,R7 51$: MATCHC R7,- @TARGET_WORD_A,- R5, (R9)[R4] ;Find match to target_string in dictionary pages BEQL 60$ ;word found SOBGTR R7, 51$ ;search again for word minus one character from end ;Find best match of next character. ;At this point R3 points to one character after last character matched. ;Either a character of current word, a space character at end of word, ;or first character of next word (or null byte signifying end of dictionary) ;if complete match. Back up one character, then search forwards for first ;space, marking end of current word and beginning of next word. ;Then search forward word by word until current dictionary word > target_word 60$: MOVL R3,R7 DECL R7 ;back up one character BRB 62$ ;jump into loop 61$: INCL R7 ;so we find space before next word CMPB (R7),#^x00 ;check for end of dictionary BNEQ 62$ ;branch if not end of dictionary DECL R7 ;move back to space character (space after last word in lexical database) BRB 100$ ;and branch 62$: LOCC #SPACE, #80, (R7) ;search for space char delimiting end of word. R1 = address of found character MOVL R1,R7 ;address of space before next word CMPC3 TARGET_WORD_LEN, - ;compare next word with target word (R7), - ;(destroys R0-R3) @TARGET_WORD_A ; BLSSU 61$ ;Branch if current word in dictionary less than target word ; Step 4. ; At this point, R7 points to space following word we seek. ; Count N words backwards not looking at word length ; N = nrows+1 100$: MOVL 16(AP),R8 ;R8 = nrows INCL R8 ;R8 = nrows+1 = N, the number of words to count backwards 101$: DECL R7 ;pointer into dictionary CMPL R7,LEXDBA ;check for at beginning of dictionary BLEQ 121$ ;at beginning of dictionary 103$: CMPB (R7),#SPACE ;check for space BEQL 110$ ;found the space DECL R7 ;pointer BRB 103$ ;loop 110$: SOBGTR R8,101$ ;loop until we cover R8 number of words ; Step 5. ; Count M words backwards looking at word length ; if word length >= word_column_length-1 then count as two words ; nchars = 12(AP) ; total_number_of_word_columns = INT( nchars / WORD_COLUMN_LENGTH ) ; M = ( INT( total_number_of_word_columns / 2 ) - 1 ) * nrows ; R8 = M DIVL3 #WORD_COLUMN_LENGTH,12(AP),R8 ;R8 = total number of word columns DIVL2 #2,R8 ;R8 = INT( total number of word columns / 2 ) DECL R8 ;R8 = INT( total number of word columns / 2 ) -1 MULL2 16(AP),R8 ;R8 = M INCL R8 ;R8 = M+1 (will be decremented by SOBGTR) BRB 120$ ;enter loop 111$: DECL R7 ;pointer into dictionary CMPL R7,LEXDBA ;check for at beginning of dictionary BLEQ 121$ ;at beginning of dictionary CLRL R0 ;counter of word length 113$: CMPB (R7),#SPACE ;check for space BEQL 120$ ;found the space DECL R7 ;pointer INCL R0 ;word length CMPL R0,#<WORD_COLUMN_LENGTH-1> ;see if word is longer than 19 chars BNEQ 113$ ;loop (if word < 19) DECL R8 ;count as word (word longer than 19) CLRL R0 ;reset word length BRB 113$ ;loop 120$: SOBGTR R8,111$ ;loop until we cover R8 number of words 121$: PUSHL 16(AP) ;nrows PUSHL 12(AP) ;nchars INCL R7 ;point to first char of word PUSHL R7 ;Pointer into dictionary CALLS #3,DIC_BROWSE_FILL RET ;------------------------------------------------------------------------------ .SUBTITLE DIC_BROWSE_FILL ;++ ; ; Functional Description: ; Fills OUTSTR with words from dictionary starting at 4(AP) address ; into lexical database. ; ; Argument inputs: ; (AP) = 3 number of arugments ; 4(AP) = address in dictionary lexical database to start at. ; 8(AP) = nchars - number of characters across window display (width) ; 12(AP) = nrows - number of rows in window display to fill (height) ; ; Outline: ; Create temporary buffer for OUTSTR and fill it in. We fill in ; the words starting with the first (left most) column, working our ; way down that column to the bottom. Then proceeding with the ; next column until all the columns are filled. For each word ; we calculate the offset into OUTSTR as follows: ; ; offset = row_number * nchars_per_row + ; word_column_number * word_column_length ; ; where row_number goes from 0 to nrows-1 with nrows = 16(AP) ; and word_column_number goes from 0 to number_of_word_columns-1 ; with number_of_word_columns = INT( nchars / WORD_COLUMN_LENGTH ) ; ; If not working on first (left most) column then we check ; to see if the word in the previous column is overflowing into ; the cell we were going to place our current word. If so we ; move down the column to the next cell and try again. ; ; If working on the last (right most) column then we check to ; see if the word we are inserting is longer than will fit on ; the screen. If so we truncate it and replace the last character ; with a "." ; ; MEMORY ALLOCATED ON STACK: ; ----------------------------------------- ; | OUTSTR BUFFER | (R10) ; | . | ; | . | ; | . | ; | . | ; | . | ; ----------------------------------------- ; ;-- .PSECT CODE NOWRT,EXE,PIC,LONG,SHR .ENTRY DIC_BROWSE_FILL,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11> ; Registar usage: ; R1 = points to space char after word in dictionary. Set by LOCC ; R2 = offset into OUTSTR ; R6 = length of current word ; R7 = row_number working on (0 to nrow-1) ; R8 = word_column_number working on (0 to ncol-1) ; R9 = pointer into dictionary at start of next word from 4(AP) ; R10 points to start of our OUTSTR buffer ; R11 points to end of current word MOVL 4(AP),DICPTRA ;set DICPTRA MOVL 4(AP),R9 ;R9 = address of first char of first word MULL3 8(AP),12(AP),R0 ;calculate length of OUTSTR (rows x columns) SUBL2 R0,SP ;allocate memory on stack to bulid OUTSTR SUBL2 #80,SP ;allocate 80 so min is at least 80 (necessary for dump_dictionary) BICB2 #^B0011,SP ;longword align stack pointer MOVL SP,R10 ;save starting address of string MOVC5 #0,(SP),#SPACE,R0,(R10) ;blank fill our OUTSTR buffer ;LOOP OVER ALL COLUMNS ; LOOP OVER ALL ROWS ; R8 = word column number ; R7 = row number CLRL R8 ;start at first column 125$: CLRL R7 ;Start at first row of new column 130$: CMPB (R9),#00 ;check for end of dictionary BEQL 200$ ;branch if at end of dictionary LOCC #SPACE, #80, (R9) ;search for space char delimiting end of word. R1 = address of found character MOVL R1,R11 ;Save R1 for later SUBL3 R9,R1,R6 ;length of word 132$: MULL3 R7,8(AP),R2 ;OFFSET R2=row_length*row_number MULL3 R8,#WORD_COLUMN_LENGTH,R3 ;R3=word_column_number*word_column_length ADDL2 R3,R2 ;R2 = offset into OUTSTR TSTL R8 ;test word_column_number BEQL 140$ ;branch if this is first column SUBL3 #1,R2,R0 ;Test previous character for blank CMPB (R10)[R0],#SPACE ; BEQL 135$ ;branch if OK, was a space AOBLSS 12(AP),R7,132$ ;loop over nrows CLRL R7 DIVL3 #WORD_COLUMN_LENGTH,8(AP),R0 ;R0 = total number of word columns AOBLSS R0,R8,132$ ;loop over ncols BRB 200$ 135$: DIVL3 #WORD_COLUMN_LENGTH,8(AP),R0 ;R0 = number of word_columns we can fit across screen DECL R0 ;(word_columns count from 0 to 3) CMPL R0,R8 ;is word_column = last_word_column? BNEQ 140$ ;branch if not CMPL R6,#<WORD_COLUMN_LENGTH> ;see if word longer than screen length left BLEQ 140$ ;continue if not PUSHL R2 MOVC3 #<WORD_COLUMN_LENGTH-1>,(R9),(R10)[R2] ;insert word into OUTSTR POPL R2 ADDL2 #<WORD_COLUMN_LENGTH-1>,R2 MOVB #^A".",(R10)[R2] BRB 142$ 140$: MOVC3 R6,(R9),(R10)[R2] ;insert word into OUTSTR 142$: ADDL3 #1,R11,R9 ;R9 points to start of next word 145$: AOBLSS 12(AP),R7,130$ ;loop over nrows DIVL3 #WORD_COLUMN_LENGTH,8(AP),R0 ;R0 = total number of word columns AOBLSS R0,R8,125$ ;loop over ncols ;We drop out here when our OUTSTR buffer is full ;Set OUTSTR and return 200$: MOVL R9,DICPTRZ ;set DICPTRZ PUSHL R10 ;address of OUTSTR buffer MULL3 8(AP),12(AP),-(SP) ;length of OUTSTR buffer (rows x columns) PUSHL #1 ;return status CALLS #3,FMTOUTSTR RET ;------------------------------------------------------------------------------ .SUBTITLE SPELL_GUESS ;++ ; ; Functional Description: ; Guesses the spelling of misspelled word stored in DIC_LWA,DIC_LWL. ; Algorythm taken from the very popular Vassar Spelling Checker. ; With credit to Vassar where credit is due. ; ; Calling Sequence: ; CALLS #0,SPELL_GUESS ; ; Argument inputs: ; DIC_LWA - Address of misspelled word ; DIC_LWL - Length of misspelled word ; ; Outputs: ; here's another word to try ; retcode=LIB$_NORMAL, outline="guessed word" ; ask user if guessed word is what he ment ; or ; no more guesses, retcode = LIB$_NOTFOU ; ; Outline: ; 1. Reversals (test for transposed characters) ; 2. vowels (test for wrong vowel used) ; 3. minus chars (test for extra character in word) ; 4. plus chars (test for character missing from word) ; 5. consonants (test for wrong character used) ; 6. give up (give up) ; ; Memory Map (Memory allocated on stack): ; ----------------------------------------- ; | GUESS WORD BUFFER | (R9) ; | . | ; | . | ; ----------------------------------------- ; |(original stack pinter) ; ;-- .PSECT DATA RD,WRT,NOEXE,LONG,PIC,NOSHR GMODE: .BLKB 1 ;guess mode (1=reversals,2=vowels,3=minus,4=plus,5=consonants,6=giveup) GSUBMODE: .BLKB 1 ;guess submode (letter we're currently replacing with) GCOL: .BLKB 1 ;guess column (character # in word working on) .PSECT CODE NOWRT,EXE,PIC,LONG,SHR .ENTRY SPELL_GUESS,^M<R2,R9,R10> SUBL2 DIC_LWL,SP ;allocate memory for guess word DECL SP ;allocate more memory for guess_pluss BICB2 #^B0011,SP ;longword align stack pointer MOVL SP,R9 ;store address of guess word buffer GUSINI: CASEB GMODE, #1, #<6-1> ;Case entry point to jump to 1$: .WORD GUSREV-1$,- ; 1 = guess reversals GUSVOL-1$,- ; 2 = guess vowels GUSMIN-1$,- ; 3 = guess minus GUSPLS-1$,- ; 4 = guess plus GUSCON-1$,- ; 5 = guess consonants GIVEUP-1$ ; 6 = give up MOVL #EDX__UNKNCODE,R0 ;Put error status in R0 ; JSB ERR ;Signal error RET ;and return with error status in R0 GIVEUP: MOVB #1,GMODE ;reset GMODE MOVB #1,GCOL ;reset GCOL MOVB #1,GSUBMODE ;reset GSUBMODE PUSHL #SS$_ENDOFFILE CALLS #1,FMTOUTSTR RET CKVOWEL: ;test R0 for vowel char. return R0=1 if vowel, R0=0 if not vowel. CMPB R0, #^A"A" ;test for vowel "A" BEQL 10$ CMPB R0, #^A"E" ;test for vowel "E" BEQL 10$ CMPB R0, #^A"I" ;test for vowel "I" BEQL 10$ CMPB R0, #^A"O" ;test for vowel "O" BEQL 10$ CMPB R0, #^A"U" ;test for vowel "U" BEQL 10$ CLRL R0 RSB 10$: MOVZBL #1,R0 11$: RSB ; Guess reversals. Copy word and transpose x with x-1 till x = DIC_LWL GUSREV: CMPB GCOL,DIC_LWL ;test for end of word BLSS 2$ ;branch if not INCB GMODE ;go to next guess mode MOVB #1,GCOL ;reset GCOL MOVB #1,GSUBMODE ;reset GSUBMODE BRW GUSINI ;go do next mode 2$: MOVC3 DIC_LWL,@DIC_LWA,(R9) ;copy over word MOVZBL GCOL,R10 ;swap chars DECL R10 ;convert index to offset MOVZBL GCOL,R1 MOVB (R9)[R10],R2 MOVB (R9)[R1],(R9)[R10] MOVB R2,(R9)[R1] PUSHL R9 ;address of guess word PUSHL DIC_LWL ;word length CALLS #2,DIC_LOOKUP_WORD ;See if word exists INCB GCOL ;move to next character BLBC R0,GUSREV ;loop if word not found PUSHL R9 ;address of output string PUSHL DIC_LWL ;length of output string PUSHL R0 ;retcode CALLS #3,FMTOUTSTR ;format output string RET ;return with string containing a correctly spelled word, status ;Guess vowel replacements. for each {a,e,i,o,u} replace with {a,e,i,o,u} ;GSUBMODE goes from 1-5 as letter replacement goes a,e,i,o,u GUSVOL: CMPB GCOL,DIC_LWL ;test for beyond end of word BLEQ 2$ ;branch if not INCB GMODE ;go to next guess mode MOVB #1,GCOL ;reset GCOL MOVB #1,GSUBMODE ;reset GSUBMODE BRW GUSINI ;go do next mode 2$: MOVC3 DIC_LWL,@DIC_LWA,(R9) ;copy over word MOVZBL GCOL,R10 DECL R10 ;convert index to offset MOVZBL (R9)[R10],R0 BSBW CKVOWEL ;test if R0 is vowel char BLBS R0,10$ ;branch if vowel INCB GCOL ;this character is not a vowel BRW GUSVOL ;loop and test next character 10$: CASEB GSUBMODE, #1, #<5-1> ;Case entry point to jump to 11$: .WORD 21$-11$,- ; 1 = replace with an "A" 22$-11$,- ; 2 = replace with an "E" 23$-11$,- ; 3 = replace with an "I" 24$-11$,- ; 4 = replace with an "O" 25$-11$ ; 5 = replace with an "U" MOVL #EDX__GUSINTERR2,R0 ;Put error status in R0 ; JSB ERR ;Signal error RET ;and return with error status in R0 21$: MOVB #^A"A", (R9)[R10] BRB 30$ 22$: MOVB #^A"E", (R9)[R10] BRB 30$ 23$: MOVB #^A"I", (R9)[R10] BRB 30$ 24$: MOVB #^A"O", (R9)[R10] BRB 30$ 25$: MOVB #^A"U", (R9)[R10] 30$: MOVL DIC_LWA,R1 CMPB (R9)[R10],(R1)[R10] ;check that we didn't replace an "A" with an "A", etc. BNEQ 32$ ;continue if word is different INCB GSUBMODE ;guess next vowel CMPB GSUBMODE, #5 ;test for all vowels tried BLEQ 31$ ;branch if not all vowels tried INCB GCOL ;all vowels tried. move to next column MOVB #1,GSUBMODE ;reset GSUBMODE 31$: BRW GUSVOL 32$: PUSHL R9 ;address of guess word PUSHL DIC_LWL ;word length CALLS #2,DIC_LOOKUP_WORD ;See if word exists INCB GSUBMODE ;set to guess next vowel CMPB GSUBMODE, #5 ; test for all vowels tried BLEQ 38$ ; branch if not all vowels tried INCB GCOL ; all vowels tried. move to next column MOVB #1,GSUBMODE ; reset GSUBMODE 38$: BLBS R0,40$ ;Test status from DIC_LOOKUP_WORD. Branch if word exists. BRW GUSVOL ;else loop and try again 40$: PUSHL R9 ;address of output string PUSHL DIC_LWL ;length of output string PUSHL R0 ;retcode CALLS #3,FMTOUTSTR ;format output string RET ;return with string containing a correctly spelled word, status ;Guess minus. Test for extra character. Try eliding one character at a time GUSMIN: CMPB GCOL,DIC_LWL ;test for beyond end of word BLEQ 2$ ;branch if not INCB GMODE ;go to next guess mode MOVB #1,GCOL ;reset GCOL MOVB #1,GSUBMODE ;reset GSUBMODE BRW GUSINI ;go do next mode 2$: MOVC3 DIC_LWL,@DIC_LWA,(R9) ;copy over word MOVZBL GCOL,R10 ;remove GCOL'th character from word DECL R10 ;convert index to offset MOVZBL GCOL,R1 CMPB (R9)[R1],(R9)[R10] ;if prev char = current char then BNEQ 8$ ; the result would be the same as last time. INCB GCOL ; so skip it BRW GUSMIN 8$: SUBL3 R1,DIC_LWL,R2 MOVC3 R2,(R9)[R1],(R9)[R10] ;(shift GCOL'th+1 to end of word left one) PUSHL R9 ;address of guess word SUBL3 #1,DIC_LWL,-(SP) ;length of guess word CALLS #2,DIC_LOOKUP_WORD ;See if word exists INCB GCOL ;move to next character BLBS R0,40$ ;branch if word exists BRW GUSMIN ;else loop and try again 40$: PUSHL R9 ;address of output string SUBL3 #1,DIC_LWL,-(SP) ;length of output string PUSHL R0 ;retcode CALLS #3,FMTOUTSTR ;format output string RET ;return with string containing a correctly spelled word, status ;Guess plus. Test if a letter is missing from word. Add one letter anywhere in word ;GSUBMODE goes from 1-26 as letter replacement goes from a-z GUSPLS: CMPB GSUBMODE, #26 ;test for GSUBMODE=26 (all letters of alphabet) BLEQ 2$ ;branch if not done "Z" yet CMPB GCOL,DIC_LWL ;test for beyond end of word BGTR 1$ ;branch if GCOL greater than word_length+1 INCB GCOL ;move to next character in word MOVB #1,GSUBMODE ;reset GSUBMODE BRB 2$ ;and continue 1$: INCB GMODE ;go to next guess mode MOVB #1,GCOL ;reset GCOL MOVB #1,GSUBMODE ;reset GSUBMODE BRW GUSINI ;go do next mode 2$: MOVC3 DIC_LWL,@DIC_LWA,(R9) ;copy over word (movc3 destroys R0-R5) MOVZBL GCOL,R10 ;add character before GCOL'th character DECL R10 ;convert index to offset MOVZBL GCOL,R1 SUBL3 R10,DIC_LWL,R2 ;length from GCOL'th to end MOVC3 R2,(R9)[R10],(R9)[R1] ;(shift GCOL'th to end of word right one) ADDB3 #^A"A", GSUBMODE, (R9)[R10] ;convert GSUBMODE={1-26} to ASCII {A-Z} (which is {65-90} DECB (R9)[R10] ; by adding 64 to GSUBMODE PUSHL R9 ;address of guess word ADDL3 #1,DIC_LWL,-(SP) ;length of guess word CALLS #2,DIC_LOOKUP_WORD ;See if word exists INCB GSUBMODE ;try next character in alphabet BLBS R0,40$ ;branch if word exists BRW GUSPLS ;else loop and try again 40$: PUSHL R9 ;address of output string ADDL3 #1,DIC_LWL,-(SP) ;length of output string PUSHL R0 ;retcode CALLS #3,FMTOUTSTR ;format output string RET ;return with string containing a correctly spelled word, status ;guess consonants. Test for any one character wrong. ;Replace each character with every other character of the alphabet ;GSUBMODE goes from 1-26 as letter replacement goes from a-z GUSCON: CMPB GSUBMODE, #26 ;test for GSUBMODE=26 (all letters of alphabet) BLEQ 2$ ;branch if not done "Z" yet CMPB GCOL,DIC_LWL ;test for beyond end of word BGEQ 1$ ;branch if GCOL greater than word_length+1 INCB GCOL ;move to next character in word MOVB #1,GSUBMODE ;reset GSUBMODE BRB 2$ ;and continue 1$: INCB GMODE ;go to next guess mode MOVB #1,GCOL ;reset GCOL MOVB #1,GSUBMODE ;reset GSUBMODE BRW GUSINI ;go do next mode 2$: MOVC3 DIC_LWL,@DIC_LWA,(R9) ;copy over word MOVZBL GCOL,R10 DECL R10 ;convert index to offset ADDB3 #^A"A", GSUBMODE, R1 ;convert GSUBMODE={1-26} to ASCII {A-Z} (which is {65-90} DECB R1 ; by adding 64 to GSUBMODE MOVZBL (R9)[R10],R0 ;original character CMPB R0,R1 ;Skip if replacing original BEQL 19$ ; with same char BSBW CKVOWEL ;test if original char a vowel BLBC R0,31$ ;branch if not a vowel MOVZBL R1,R0 ;test replacement char for vowel BSBW CKVOWEL ;test if original char a vowel BLBC R0,31$ ;branch if replacement not a vowel 19$: INCB GSUBMODE ;Both original and replacement were vowels BRW GUSCON ; We skip this since Guess Vowels already did it 31$: MOVB R1,(R9)[R10] ;replace char PUSHL R9 ;address of guess word PUSHL DIC_LWL ;word length CALLS #2,DIC_LOOKUP_WORD ;See if word exists INCB GSUBMODE ;move to next character BLBS R0,40$ ;branch if word exists BRW GUSCON ;else loop and try again 40$: PUSHL R9 ;address of output string PUSHL DIC_LWL ;length of output string PUSHL R0 ;retcode CALLS #3,FMTOUTSTR ;format output string RET ;return with string containing a correctly spelled word, status ;------------------------------------------------------------------------------ .SUBTITLE ACCEPTED_WORD_LIST ;++ ; SPELL_ACCEPT_WORD ; ; Functional Description: ; Constructs a balanced binary tree of words which the user has instructed ; us to accept as properly spelled. The VMS library routine ; LIB$INSERT_TREE is used to build the tree. DIC_LOOKUP_WORD uses ; the VMS library routine LIB$LOOKUP_TREE to search this tree for a ; match before declaring a word misspelled. ; ; The routines ALLOCATE_NODE and COMPARE_NODE are called by LIB$INSET_TREE ; and LIB$LOOKUP_TREE. ALLOCATE_NODE allocates memory and inserts ; the word to accept in the allocated memory. COMPARE_NODE ; alphabetically compares the word stored in a given memory block ; with a given word to determine which comes first. ; ; Calling Sequence: ; CALLS #0,SPELL_ACCEPT_WORD ; ; Inputs: ; DIC_LWA - Address of word to accept. Set by DIC_LOOKUP_WORD. ; DIC_LWL - Length of word to accept. Set by DIC_LOOKUP_WORD. ; ;-- .PSECT STATSHR RD,NOWRT,NOEXE,LONG,PIC,SHR BTFLAGS: .LONG 0 ;no duplicates flag .PSECT DATA RD,WRT,NOEXE,LONG,PIC,NOSHR NEWNODE: .LONG 0 TREE_HEAD: .LONG 0 .PSECT CODE NOWRT,EXE,PIC,LONG,SHR .ENTRY SPELL_ACCEPT_WORD,^M<> JSB INITVMZONE PUSHAL NEWNODE ;new node return address PUSHAB ALLOCATE_NODE ;allocate node routine PUSHAB COMPARE_NODE ;compare node routine PUSHAL BTFLAGS ;no duplicates PUSHAQ DIC_LWL ;DIC_LWL + DIC_LWA, our word to add PUSHAL TREE_HEAD ;tree head for the binary tree CALLS #6,G^LIB$INSERT_TREE ;add the word PUSHL R0 CALLS #1,FMTOUTSTR RET ;; For debugging purposes: ;; .ENTRY TRAVERSE_TREE,^M<> ;; PUSHAB PRINT_NODE ;; PUSHAL TREE_HEAD ;; CALLS #2,G^LIB$TRAVERSE_TREE ;; RET ;; .ENTRY PRINT_NODE,^M<> ;; SUBL2 #8,SP ;allocate space for descriptor ;; MOVL 4(AP),R0 ;; MOVW 10(R0), DSC$W_LENGTH(SP) ;length ;; MOVB #DSC$K_DTYPE_T, DSC$B_DTYPE(SP) ;Type ;; MOVB #DSC$K_CLASS_S, DSC$B_CLASS(SP) ;Class ;; MOVAL 12(R0), DSC$A_POINTER(SP) ;address ;; PUSHL SP ;; CALLS #1,G^LIB$PUT_OUTPUT ;; RET ;++ ; ALLOCATE_NODE ; ; Functional Description: ; Allocates memory for a new node being added in a balanced binary ; tree by LIB$INSERT_TREE. (alloc-rtn) ; ; Calling Sequence: ; Called by LIB$INSERT_TREE ; ; Argument inputs: ; (AP) - number of arguments (#3 by value) ; 4(AP) - sym-str (input). Address of string descriptor of string to ; insert in this node. (Descriptor class and type fields not used). ; 8(AP) - ret-adr (output). Address to place starting address of block of ; memory allocated and filled in. ; 12(AP) - [user-data] (not used) ; ; Outputs: ; R0 = SS$_NORMAL ; ; Outline: ; 1. Memory is allocated and filled in as shown below: ; ; Memory Map: ; -----------------------------------------( address of node placed in ret-adr, @8(AP) ) ; | left link | ; ----------------------------------------- ; | right link | ; ----------------------------------------- ; | STRING LENGTH | balance | ; ----------------------------------------- ; | STRING | 12(R10) ; | . | ; | . | ; ----------------------------------------- ; ; The node header, consisting of the first 10 bytes of the node containing ; the left link, right link, and balance, is reserved for use by LIB$INSERT_TREE ; We fill in the string length, and the string itself, and we allocate enough ; memory to hold it all (12 bytes + length of string). ; ;Registar usage: ; R10 = address of node memory block ; R9 = address of string descriptor ;-- .PSECT CODE NOWRT,EXE,PIC,LONG,SHR .ENTRY ALLOCATE_NODE,^M<R2,R3,R4,R5,R9,R10> CLRL -(SP) ;reserve a place to put length of memory to allocate ADDW3 #12,@4(AP),(SP) ;calculate length of memory = 12 for header + length of string (from descriptor) MOVL SP,R0 ;R0 = address containing length of memory to allocate PUSHAL VM_ZONE ;Our virtual memory zone id PUSHL 8(AP) ;Address to place starting address of allocated memory PUSHL R0 ;length of memory to allocate (by reference) CALLS #2,G^LIB$GET_VM ;get memory for new node CLRL (SP)+ ;fix stack pointer BLBS R0,2$ ;branch on success PUSHL R0 ;else we're in trouble... PUSHL R0 CALLS #1,EDX_SIGNAL CALLS #1,FMTOUTSTR RET 2$: MOVL 4(AP),R9 ;address of string descriptor MOVL @8(AP),R10 ;address of memory block MOVW (R9),10(R10) ;fill in length of string MOVC3 (R9),@4(R9),12(R10) ;fill in string MOVZBL #1,R0 ;set success status RET ;and return ;++ ; COMPARE_NODE ; ; Functional Description: ; Compares string to string contained in a given node. Returns ; +1,0,-1 for string GTR,EQL,LSS than given node. ; ; Calling Sequence: ; Called by LIB$INSERT_TREE ; ; Argument inputs: ; (AP) - number of arguments (#3 by value) ; 4(AP) - sym-str (input). Address of string descriptor of string to ; compare with given node. (Descriptor class and type fields not used). ; 8(AP) - treehead (input). Address of node to compare with string. ; The format of a node is shown in the memory map below. ; 12(AP) - [user-data] (not used) ; ; Outputs: ; R0 = +1 if string > node ; 0 if string = node ; -1 if string < node ; ; Memory Map: ; ----------------------------------------- (R10) ; | left link | ; ----------------------------------------- ; | right link | ; ----------------------------------------- ; | STRING LENGTH | balance | ; ----------------------------------------- ; | STRING | 12(R10) ; | . | ; | . | ; ----------------------------------------- ; ;Registar usage: ; R10 = address of node memory block ; R9 = address of string descriptor ;-- .PSECT CODE NOWRT,EXE,PIC,LONG,SHR .ENTRY COMPARE_NODE,^M<R2,R3,R9,R10> MOVL 4(AP),R9 ;address of string descriptor MOVL 8(AP),R10 ;address of node memory block CMPC5 (R9),@4(R9),#SPACE,10(R10),12(R10) ;do the compare BLSS 1$ ;string < node BEQL 2$ ;string = node MOVZBL #1,R0 ;string > node RET 1$: MNEGL #1,R0 ;string < node RET 2$: CLRL R0 ;string = node RET ;------------------------------------------------------------------------------ .SUBTITLE ADD_PERSDIC ;++ ; ADD_PERSDIC ; ; Functional Description: ; Adds the current unrecognised word to the user's personal dictionary. ; ; Calling Sequence: ; CALLS #0,SPELL_ACCEPT_WORD ; ; Inputs: ; DIC_LWA - Address of word to accept. Set by DIC_LOOKUP_WORD. ; DIC_LWL - Length of word to accept. Set by DIC_LOOKUP_WORD. ; ; Outline: ; 1. Open user's personal dictionary. If file does not exist, ; it is created. ; 2. Add new word to end of file. ; 3. Close file. ; ; Memory Map (Memory allocated on stack): ; ----------------------------------------- ; | buffer for filename | (R9) ; | . | ; | . | ; | | ; ----------------------------------------- ;-- .PSECT DATA RD,WRT,NOEXE,LONG,PIC,NOSHR ADDPDICFAB: ; Personal dictionary $FAB FNM = <EDXPERSDIC>, - DNM = <SYS$LOGIN:EDXPERSDIC.DAT>, - NAM = ADDPDICNAM, - FAC = <PUT>, - SHR = <GET>, - FOP = CIF ;Create if nonexistent ADDPDICRAB: $RAB FAB = ADDPDICFAB, - ; Pointer to FAB ROP = EOF ; Position to end of file for append operation ADDPDICNAM: $NAM RSS = NAM$C_MAXRSS ;------------------------------------------------------------------------------ .PSECT CODE NOWRT,EXE,PIC,LONG,SHR .ENTRY ADD_PERSDIC,^M<R9> SUBL2 #NAM$C_MAXRSS,SP ;Allocate buffer for filename BICB2 #^B0011,SP ;longword align stack pointer MOVL SP,R9 ;store buffer address in R9 MOVL R9,ADDPDICNAM+NAM$L_RSA ;Store buffer address in NAM block ;OPEN THE USER'S PERSONAL DICTIONARY FILE $CREATE FAB=ADDPDICFAB ;Open user's personal dictionary file BLBC R0,20$ ;A new file is created only if CMPL R0,#RMS$_CREATED ;one does not already exist. BNEQ 10$ PUSHL R9 ;filename address MOVZBL ADDPDICNAM+NAM$B_RSL,-(SP) ;filename size PUSHL #2 ;2 FAO args PUSHL #EDX__CREPERSDIC ;Created new personal dictionary CALLS #4,EDX_SIGNAL ;signal message 'Created new personal dictionary' 10$: $CONNECT RAB=ADDPDICRAB ;Connect to input BLBS R0,30$ ;branch if OK 20$: ;error processing PUSHL #0 ;0 FAO args PUSHL R0 ;RMS error PUSHL R9 ;filename address MOVZBL ADDPDICNAM+NAM$B_RSL,-(SP) ;filename size PUSHL #2 ;2 FAO args PUSHL #EDX__PERSDICERR ;error opening personal dictionary MOVL R0,R9 ;Save R0 error CALLS #6,EDX_SIGNAL ;signal message MOVL R9,R0 ;Restore R0 error RET ;and return with R0 error 30$: MOVL DIC_LWA,ADDPDICRAB+RAB$L_RBF MOVW DIC_LWL,ADDPDICRAB+RAB$W_RSZ $PUT RAB=ADDPDICRAB ;Add word to user's personal dictionary BLBS R0,40$ ;Branch if good MOVL ADDPDICRAB,R1 PUSHL RAB$L_STV(R1) ;push STV and STS of RAB PUSHL RAB$L_STS(R1) CALLS #2,EDX_SIGNAL ;Signal error BRB 100$ 40$: PUSHL R9 ;filename address MOVZBL ADDPDICNAM+NAM$B_RSL,-(SP) ;filename size PUSHL DIC_LWA ;word address PUSHL DIC_LWL ;word size PUSHL #4 ;4 FAO args PUSHL #EDX__WORDADD ;Added word to personal dictionary CALLS #6,EDX_SIGNAL ;signal message 100$: $CLOSE FAB=ADDPDICFAB ;close file RET ;------------------------------------------------------------------------------ .SUBTITLE DUMP_COMMONWORDS ;++ ; DUMP_COMMONWORDS ; ; Functional Description: ; Returns as a single string the list of common words as stored in ; the EDX dictionary database file. ; ; Calling Sequence: ; CALLS #0,DUMP_COMMONWORDS ; ; Outputs: ; OUTSTR - String of common words ; ;-- .PSECT CODE NOWRT,EXE,PIC,LONG,SHR .ENTRY DUMP_COMMONWORDS,^M<R11> MOVL DIC_HEADER,R11 PUSHL DIC_CMNWDS ;address of output string PUSHL DIC_CWDLEN(R11) ;length of output string PUSHL #1 ;retcode CALLS #3,FMTOUTSTR ;format output string RET ;return with string containing a correctly spelled word, status ;------------------------------------------------------------------------------ ;============================================================================== ; LOCK FILES ;============================================================================== .SUBTITLE LOCK_FILE ;++ ; ; Functional Description: ; This routine locks a file to prevent others from editing that file ; by opening that file with a noshare attribute. ; ; Calling Sequence: ; CALLS #0,LOCK_FILE ; ; Outline: ; A new block of memory is allocated and used as shown below. ; A linked list of LNKFABLST BLOCKS is maintained. The static ; variable LNKFABLST points to the first block. LNKFABNXT within ; each block points to the next block or is zero if no more blocks. ; ; LNKFABLST BLOCK ; -----------------------------------------(start of FAB block) ; | IFI | BLN | BID | 00 + LNKFABLST ; ----------------------------------------- ; | FOP | 04 ; ----------------------------------------- ; | STS | 08 ; ----------------------------------------- ; | STV | 0C ; ----------------------------------------- ; | ALQ | 10 ; ----------------------------------------- ; | SHR | FAC | DEQ | 14 ; ----------------------------------------- ; | CTX | 18 ; ----------------------------------------- ; | RFM | RAT | ORG | RTV | 1C ; ----------------------------------------- ; | | |FACILITY | JOURNAL | 20 ; ----------------------------------------- ; | XAB | 24 ; ----------------------------------------- ; | NAM | 28 ; ----------------------------------------- ; | FNA | 2C ; ----------------------------------------- ; | DNA | 30 ; ----------------------------------------- ; | MRS | DNS | FNS | 34 ; ----------------------------------------- ; | MRN | 38 ; ----------------------------------------- ; | FSZ | BKS | BLS | 3C ; ----------------------------------------- ; | DEV | 40 ; ----------------------------------------- ; | SDC | 44 ; ----------------------------------------- ; | RCF | ACMODES | GBC | 48 ; ----------------------------------------- ; | | | | | 4C ; ----------------------------------------- (start of NAM block) ; | RSL | RSS | BLN | BID | 00 + FAB$C_BLN + LNKFABLST ; ----------------------------------------- ; | RSA | 04 ; ----------------------------------------- ; | ESL | ESS | RFS | NOP | 08 ; ----------------------------------------- ; | ESA | 0C ; ----------------------------------------- ; | RLF | 10 ; ----------------------------------------- ; | | | | | 14 ; ----------------------------------------- ; | | | | | 18 ; ----------------------------------------- ; | | | | | 1C ; ----------------------------------------- ; | | | | | 20 ; ----------------------------------------- ; | FID_SEQ | FID_NUM | 24 ; ----------------------------------------- ; | DID | FID_NBX | FID_RVN | 28 ; ----------------------------------------- ; | DID_NMX | DID_RVN | DID_SEQ | 2C ; ----------------------------------------- ; | WCC | 30 ; ----------------------------------------- ; | FNB | 34 ; ----------------------------------------- ; | NAME | DIR | DEV | NODE | 38 ; ----------------------------------------- ; | | | VER | TYPE | 3C ; ----------------------------------------- ; | NODE | 40 ; ----------------------------------------- ; | DEV | 44 ; ----------------------------------------- ; | DIR | 48 ; ----------------------------------------- ; | NAME | 4C ; ----------------------------------------- ; | TYPE | 50 ; ----------------------------------------- ; | VER | 54 ; ----------------------------------------- ; | | | | | 58 ; ----------------------------------------- ; | | | | | 5C ; -----------------------------------------(pointer to next LNKFABLST block in linked list) ; | LNKFABNXT | 00 + NAM$C_BLN + FAB$C_BLN + LNKFABLST ; -----------------------------------------(expanded file name string returned) ; | EXPANDED FILE NAME STRING | 04 + NAM$C_BLN + FAB$C_BLN + LNKFABLST ; | . | ; | . | ; | | (NAM$C_MAXRSS in length) ; ----------------------------------------- ; | RESULTANT FILE NAME STRING | 04 + NAM$C_BLN + FAB$C_BLN + LNKFABLST + BUFLEN ; | . | ; | . | ; | | (NAM$C_MAXRSS in length) ; ----------------------------------------- ; | 04 + NAM$C_BLN + FAB$C_BLN + LNKFABLST + 2*BUFLEN ; ;------------------------------------------------------------------------------ .PSECT DATA RD,WRT,NOEXE,LONG,PIC,NOSHR LNKFABNXT = FAB$C_BLN + NAM$C_BLN ;Offset to LNKFABNXT LNKFABLEN = FAB$C_BLN + NAM$C_BLN + 4 + <2*BUFLEN> ;Length of memory block to allocate LNKFABLST:: .LONG 0 ;Pointer to first LNKFABLST BLOCK (initialize at zero) ;------------------------------------------------------------------------------ .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY LOCK_FILE,^M<R2,R3,R5,R6,R8,R9> ;Check virtual memory zone BSBW INITVMZONE ;Initialize our virtual memory zone ;Go to end of linked list of LNKFABLST BLOCKS 2$: MOVAL LNKFABLST,R5 ;Address of pointer to where linked list starts 3$: MOVL (R5),R6 ;Value of pointer to where linked list starts/continues BEQLU 4$ ;If value of pointer is zero, we're at the end of the list ADDL3 R6,#<FAB$C_BLN+NAM$C_BLN>,R5 ;R6 + offset into current LNKFABLST BLOCK = address of pointer to next FAB block (LNKFABNXT) BRB 3$ ;Check value of LNKFABNXT stored in R6. ;If zero we're at end of list. ;If nonzero, then value is pointer to next LNKFABLST BLOCK. ;Allocate memory for new LNKFABLST BLOCK ;Address to return start position of block is in R5 (LNKFABNXT of last block) 4$: MOVL #LNKFABLEN,-(SP) ;Length of memory block to allocate MOVL SP,R0 ;Address of above (by reference) PUSHAL VM_ZONE ;Our virtual memory zone id PUSHL R5 ;Address to place return address of memory block allocated PUSHL R0 ;Address containing length of memory to allocate (LNKFABLEN by reference) CALLS #3,G^LIB$GET_VM ;Allocate memory for new block in linked list CLRL (SP)+ ;Restore stack pointer ;Initialize LNKFABLST BLOCK ;R5 = Address where address of new LNKFABLST BLOCK stored MOVL (R5),R8 ;R8 = Base address of new LNKFABLST BLOCK ADDL3 #FAB$C_BLN,R8,R9 ;R9 = Address of NAM block within LNKFABLST BLOCK MOVB #FAB$C_BID,FAB$B_BID(R8) ;FAB block ID # MOVB #FAB$C_BLN,FAB$B_BLN(R8) ;FAB block length MOVB #FAB$M_NIL,FAB$B_SHR(R8) ;Specify no file sharing (exclusive access) MOVL R9,FAB$L_NAM(R8) ;NAM block address MOVL INSTR,R3 ;Address of input string descriptor MOVL 4(R3),FAB$L_FNA(R8) ;Address of string containing file name MOVB (R3),FAB$B_FNS(R8) ;Length of string containing file name ;Initialize NAM block MOVB #NAM$C_BID,NAM$B_BID(R9) ;NAM block ID # MOVB #NAM$C_BLN,NAM$B_BLN(R9) ;NAM block length MOVB #NAM$C_MAXRSS,NAM$B_ESS(R9) ;Expanded file name string size MOVB #NAM$C_MAXRSS,NAM$B_RSS(R9) ;Resultant file name string size ADDL3 R9,#<NAM$C_BLN+4>,NAM$L_ESA(R9) ;Expanded file name string address ADDL3 R9,#<NAM$C_BLN+4+BUFLEN>,- NAM$L_RSA(R9) ;Resultant file name string address ;open the file $OPEN FAB=(R8) ;Open the file to lock it BLBC R0,5$ ;Branch if unsuccessful PUSHL NAM$L_RSA(R9) ;Address of resultant filename string MOVZBL NAM$B_RSL(R9),R1 ;Filename size PUSHL R1 ;Filename size PUSHL #2 ;two FAO arguments PUSHL #EDX__LOCKED ;Successfully locked message CALLS #4,EDX_SIGNAL ;Signal success message PUSHL #1 ;retcode CALLS #1,FMTOUTSTR ;format return status RET ;Normal exit ;Process error opening file ;Signal error message 5$: MOVL R0,R3 ;Save error status CMPL R0,#RMS$_FLK ;See if the error was 'file locked by another user' BNEQ 6$ ;If not then branch CALLS #0,SRCH_LNKFABLST ;(changes R2) else see if we have file already locked CMPL R0,#EDX__LOCKED ;Check for locked status BNEQ 6$ ;Branch if it's not us. PUSHL NAM$L_ESA(R9) ;Address of expanded filename string MOVZBL NAM$B_ESL(R9),R1 ;Filename size PUSHL R1 ;Filename size PUSHL #2 ;two FAO arguments PUSHL #EDX__ALK ;We already have file locked CALLS #4,EDX_SIGNAL ;Signal that message BRB 7$ ;Branch to deallocate memory 6$: PUSHL #0 ;Zero FAO arguments for error PUSHL R3 ;Push error code on stack PUSHL NAM$L_ESA(R9) ;Address of expanded filename string MOVZBL NAM$B_ESL(R9),R1 ;Filename size PUSHL R1 ;Filename size PUSHL #2 ;two FAO arguments PUSHL #EDX__NOLOCK ;Error message CALLS #6,EDX_SIGNAL ;Signal the error BRB 7$ ;Branch to deallocate memory 7$: ;Free newest LNKFABLST BLOCK that was allocated ;R5 = address of previous LNKFABLST BLOCK + LNKFABNXT pointer which points to new LNKFABLST BLOCK CLRL (R5) ;Previous node becomes last node by zeroing LNKFABNXT MOVL #LNKFABLEN,-(SP) ;Length of memory block to deallocate MOVL SP,R0 ;Address of above (by reference) PUSHAL VM_ZONE ;Our virtual memory zone id PUSHL R5 ;Address of return address of memory block allocated PUSHL R0 ;Address containing length of memory to allocate CALLS #3,G^LIB$FREE_VM ;Deallocate memory used for new FAB block CLRL (SP)+ ;Restore stack pointer CLRL (R5) ;Reset LNKFABNXT pointer of previous FAB block PUSHL #0 ;retcode CALLS #1,FMTOUTSTR ;format return status RET ;Error exit ;------------------------------------------------------------------------------ .SUBTITLE UNLOCK_FILE ;++ ; ; Functional Description: ; This procedure unlocks the specified file locked by routine LOCK_FILE ; by closing it and deallocating the memory for the LNKFABLST BLOCK. ; ; Calling Sequence: ; CALLS #0,UNLOCK_FILE ; ; Argument inputs: ; INSTR = Address of input filespec descriptor ; ; Outline: ; 1. We search the linked list LNKFABLST for the specified filename ; 2. If found we close it and remove it. If not found we signal the error. ; ; Memory Map (Memory allocated on stack): ; ; -----------------------------------------(expanded file name string of input filespec) ; | EXPANDED FILE NAME STRING | 00 (base address is stored in R7) ; | . | ; | . | ; | | ; ----------------------------------------- ; | BUFLEN ; ;-- .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY UNLOCK_FILE,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10> ;Find matching LNKFABLST BLOCK for INSTR filename CALLS #0,SRCH_LNKFABLST ;(changes R2) Search for LNKFABLST BLOCK containing filename CMPL R0,#EDX__LOCKED ;If successful then R1 = Address of previous LNKFABLST BLOCK BEQLU 2$ ;And R2 = Address of LNKFABLST BLOCK containing filename CMPL R0,#EDX__NOTLOCKED ;Test for not found failure BEQLU 1$ ;Branch if file not found PUSHL R0 ;Else signal error CALLS #1,EDX_SIGNAL ; PUSHL #0 ;retcode CALLS #1,FMTOUTSTR ;format return status RET ;and return (unknown error exit) 1$: ;File Not Found ;Came to end of linked list. No match found ;Reparse input filename not using physical device names SUBL2 #BUFLEN,SP ;Move stack pointer over memory we claim MOVL SP,R7 ;Store base address. We'll use this memory for our output buffer MOVL INSTR,R3 ;Address of INSTR to R3 MOVW (R3),R6 ;Length of input filespec from descriptor MOVL 4(R3),R5 ;Address of input filespec from descriptor MOVL #NAM$C_MAXRSS,R8 ;Length of output filespec buffer CLRL R2 ;Don't use physical device names CALLS #0,EDX_PARSE ;Parse filespec PUSHL R7 ;Address of filename string PUSHL R1 ;Filename size PUSHL #2 ;two FAO arguments PUSHL #EDX__NOTLOCKED ;File not locked message CALLS #4,EDX_SIGNAL ;Signal error PUSHL #0 ;retcode CALLS #1,FMTOUTSTR ;format return status RET ;Error exit 2$: ;Found match. Close file. ;R1 = Address of previous LNKFABNXT of previous LNKFABLST BLOCK ;R2 = Address of LNKFABLST to close MOVL R1,R4 ;Save address of previous LNKFABNXT MOVL R2,R5 ;Save address of LNKFABLST $CLOSE FAB=R5 ;Close file BLBS R0,6$ ;Branch on success PUSHL R0 ;Signal error CALLS #1,EDX_SIGNAL ;Signal error PUSHL #0 ;retcode CALLS #1,FMTOUTSTR ;format return status RET ;Error exit ;Signal success message 6$: PUSHL <FAB$C_BLN+NAM$L_RSA>(R5); Address of resultant filename string MOVZBL <FAB$C_BLN+NAM$B_RSL>(R5),R1 ;Filename size PUSHL R1 ;Filename size PUSHL #2 ;two FAO arguments PUSHL #EDX__UNLOCKED ;File unlocked message CALLS #4,EDX_SIGNAL ;Signal message ;Remove LNKFABLST node from linked list and deallocate LNKFABLST node memory ;R4 = Address of LNKFABNXT of previous LNKFABLST BLOCK ;R5 = Base address of LNKFABLST node to remove MOVL <NAM$C_BLN+FAB$C_BLN>(R5),(R4) ;LNKFABNXT of previous LNKFABLST BLOCK points to next LNKFABLST BLOCK PUSHL R5 ;Address of memory to deallocate MOVL SP,R1 ;Address of address of memory block to deallocate (address by reference) PUSHL #LNKFABLEN ;Length of memory block to deallocate MOVL SP,R0 ;Address containing length of memory block to deallocate (length by reference) PUSHAL VM_ZONE ;Our virtual memory zone id PUSHL R1 ;Address of address of memory block to deallocate (address by reference) PUSHL R0 ;Address containing length of memory to deallocate CALLS #3,G^LIB$FREE_VM ;Deallocate memory used for new FAB block PUSHL #1 ;retcode CALLS #1,FMTOUTSTR ;format return status RET ;Normal exit ;------------------------------------------------------------------------------ .SUBTITLE EDX_CKFILK ;++ ; ; Functional Description: ; This procedure searches the linked list of filenames locked by ; LOCK_FILE for a specified filename. If the file is found it ; returns #1 in RETCODE to TPU. If the file is not found it returns ; #0 in RETCODE to TPU. ; ; Calling Sequence: ; CALLS #0,EDX_CKFILK ; ; Argument inputs: ; INSTR = Address of input filespec descriptor ; ; Outline: ; 1. Call SRCH_LNKFABLST. It does all the work. ; We just check the return status and set RETCODE accordingly. ;-- .ENTRY EDX_CKFILK,^M<R2> ;Find matching LNKFABLST BLOCK for INSTR filename CALLS #0,SRCH_LNKFABLST ;(changes R2) Search for LNKFABLST BLOCK containing filename CMPL R0,#EDX__LOCKED ;Compare with success BNEQ 1$ ;Branch if it's not PUSHL #1 ;retcode CALLS #1,FMTOUTSTR ;format output string RET ;Return (normal is-locked) 1$: CMPL R0,#EDX__NOTLOCKED ;Test for not found failure BNEQ 2$ ;Branch if some other failure PUSHL #0 ;retcode CALLS #1,FMTOUTSTR ;format output string RET ;Return (normal not-locked) 2$: PUSHL R0 ;Else signal error CALLS #1,EDX_SIGNAL ; PUSHL #0 ;retcode CALLS #1,FMTOUTSTR ;format output string RET ;and return (unknown error exit) ;------------------------------------------------------------------------------ .SUBTITLE SRCH_LNKFABLST ;++ ; ; Functional Description: ; This procedure searches the linked list of filenames locked by ; LOCK_FILE for a specified filename. ; ; Calling Sequence: ; CALLS #0,SRCH_LNKFABLST ; ; Argument inputs: ; INSTR = Address of input filespec descriptor ; ; Returns: ; R0 = #EDX_LOCKED if successful, #EDX_NOTLOCKED if failure, or error status code ; R1 = Base address of previous LNKFABLST BLOCK ; R2 = Base address of current LNKFABLST BLOCK which has filename ; ; Outline: ; 1. Memory is allocated on the stack ; 2. The input filename is parsed to give a full filename ; 3. The filename of the first LNKFABLST BLOCK is parsed ; 4. A comparison of the two filenames is made ; If they match we've found our LNKFABLST BLOCK ; If they don't match we try the next LNKFABLST BLOCK ; If we come to the end of the linked list with no match we ; return with the error #EDX_NOTLOCKED ; ; Memory Map (Memory allocated on stack): ; ; -----------------------------------------(expanded file name string of input filespec) ; | EXTENDED FILE NAME STRING | 00 (base address is stored in R9) ; | . | ; | . | ; | | ; -----------------------------------------(expanded file name string from LNKFABLST block) ; | EXTENDED FILE NAME STRING | BUFLEN ; | . | ; | . | ; | | ; -----------------------------------------(original stack pointer) ; | 2*BUFLEN ; ;-- .ENTRY SRCH_LNKFABLST,^M<R3,R4,R5,R6,R7,R8,R9,R10> ;Allocate memory on stack SUBL2 #<2*BUFLEN>,SP ;Move stack pointer over memory we claim MOVL SP,R9 ;Store base address. We'll use this memory for the FAB/NAM block ;Parse input filename ;R9 = Address of output buffer MOVL INSTR,R3 ;Address of INSTR to R3 MOVW (R3),R6 ;Length of input filespec from descriptor MOVL 4(R3),R5 ;Address of input filespec from descriptor MOVL R9,R7 ;Address of output filespec buffer MOVL #NAM$C_MAXRSS,R8 ;Length of output filespec buffer MOVZBL #1,R2 ;Use physical device names CALLS #0,EDX_PARSE ;Parse filespec BLBS R0,1$ ;Branch if successful RET ;Else return with error in R0 1$: MOVL R1,R10 ;Save result length ;Go through linked list of LNKFABLST BLOCKS ;R10 = length of parsed input filespec MOVAL LNKFABLST,R4 ;Pointer to where linked list starts 2$: MOVL (R4),R5 ;R5 = base address of next LNKFABLST BLOCK BEQLU 4$ ;If value of base address is zero, we're at the end of the list MOVZBL <FAB$C_BLN+NAM$B_RSS>(R5),R6 ;Length of input filespec string ADDL2 #<4+FAB$C_BLN+ - NAM$C_BLN+BUFLEN>,R5 ;R5 = address of resultant file name string in current LNKFABLST BLOCK ADDL3 #BUFLEN,R9,R7 ;Address of output filespec buffer MOVL #NAM$C_MAXRSS,R8 ;Length of output filespec buffer MOVZBL #1,R2 ;Use physical device names CALLS #0,EDX_PARSE ;Parse output filespec ;Compare filenames ;R10 = Length of parsed input filename ;R9 = Address of parsed input filename ;R7 = Address of parsed LNKFABLST filename CMPC3 R10,(R9),(R7) ;Compare strings (destroys R0 through R3) BEQLU 5$ ;Branch if equal SUBL3 #<4+BUFLEN>,R5,R4 ;R4 = address of LNKFABNXT of current next LNKFABLST BLOCK BRB 2$ ;Loop and check next LNKFABLST BLOCK 4$: ;Came to end of linked list. No match found MOVL #EDX__NOTLOCKED,R0 ;Set return code RET ;And return. File not found in list 5$: ;Found match. Close file. ;R4 = Address of previous LNKFABNXT of previous LNKFABLST BLOCK ;R5 = 4+NAM$C_BLN+FAB$C_BLN + base address of LNKFABLST to close SUBL3 #<4+NAM$C_BLN+FAB$C_BLN+BUFLEN>,- R5,R2 ;R2 = base address of LNKFABLST to close MOVL R4,R1 ;R1 = base address of previous LNKFABNXT MOVL #EDX__LOCKED,R0 ;R0 = return code RET ;and return ;------------------------------------------------------------------------------ .SUBTITLE EDX_PARSE ;++ ; ; Functional Description: ; This routine accepts a filespec as input and parses it returning ; the full file specification using physical device names. ; ; Calling Sequence: ; CALLS #0,EDX_PARSE ; ; Argument inputs: ; R2 = If odd then use physical device names. ; R5 = Address of input filespec string ; R6 = Length of input filespec string ; R7 = Address of output filespec buffer ; R8 = Length of output filespec buffer ; ; Outputs: ; R0 = Parse status ; R1 = Length of fully parsed output filename ; ; Outline: ; 1. Memory is allocated on the stack to use for FAB/NAM BLOCK ; 2. The FAB and NAM blocks are initialized ; 3. The filespec is parsed ; ; Memory Map (Memory allocated on stack): ; ; FAB/NAM BLOCK ; -----------------------------------------(start of FAB block) ; | IFI | BLN | BID | 00 + R9 ; ----------------------------------------- ; | FOP | 04 ; ----------------------------------------- ; | STS | 08 ; ----------------------------------------- ; | STV | 0C ; ----------------------------------------- ; | ALQ | 10 ; ----------------------------------------- ; | SHR | FAC | DEQ | 14 ; ----------------------------------------- ; | CTX | 18 ; ----------------------------------------- ; | RFM | RAT | ORG | RTV | 1C ; ----------------------------------------- ; | | |FACILITY | JOURNAL | 20 ; ----------------------------------------- ; | XAB | 24 ; ----------------------------------------- ; | NAM | 28 ; ----------------------------------------- ; | FNA | 2C ; ----------------------------------------- ; | DNA | 30 ; ----------------------------------------- ; | MRS | DNS | FNS | 34 ; ----------------------------------------- ; | MRN | 38 ; ----------------------------------------- ; | FSZ | BKS | BLS | 3C ; ----------------------------------------- ; | DEV | 40 ; ----------------------------------------- ; | SDC | 44 ; ----------------------------------------- ; | RCF | ACMODES | GBC | 48 ; ----------------------------------------- ; | | | | | 4C ; ----------------------------------------- (start of NAM block) ; | RSL | RSS | BLN | BID | 00 + FAB$C_BLN + R9 = R10 ; ----------------------------------------- ; | RSA | 04 ; ----------------------------------------- ; | ESL | ESS | RFS | NOP | 08 ; ----------------------------------------- ; | ESA | 0C ; ----------------------------------------- ; | RLF | 10 ; ----------------------------------------- ; | | | | | 14 ; ----------------------------------------- ; | | | | | 18 ; ----------------------------------------- ; | | | | | 1C ; ----------------------------------------- ; | | | | | 20 ; ----------------------------------------- ; | FID_SEQ | FID_NUM | 24 ; ----------------------------------------- ; | DID | FID_NBX | FID_RVN | 28 ; ----------------------------------------- ; | DID_NMX | DID_RVN | DID_SEQ | 2C ; ----------------------------------------- ; | WCC | 30 ; ----------------------------------------- ; | FNB | 34 ; ----------------------------------------- ; | NAME | DIR | DEV | NODE | 38 ; ----------------------------------------- ; | | | VER | TYPE | 3C ; ----------------------------------------- ; | NODE | 40 ; ----------------------------------------- ; | DEV | 44 ; ----------------------------------------- ; | DIR | 48 ; ----------------------------------------- ; | NAME | 4C ; ----------------------------------------- ; | TYPE | 50 ; ----------------------------------------- ; | VER | 54 ; ----------------------------------------- ; | | | | | 58 ; ----------------------------------------- ; | | | | | 5C ; ----------------------------------------- ; ;-- .ENTRY EDX_PARSE,^M<R9,R10,R11> ;Allocate zero filled memory on stack SUBL2 #<FAB$C_BLN+NAM$C_BLN>,SP ;Allocate memory on stack MOVL SP,R9 ;Store base address. We'll use this memory for the FAB/NAM block PUSHR #^M<R2,R3,R4,R5> MOVC5 #0,(SP),#^x00,#<FAB$C_BLN+NAM$C_BLN>,(R9) ; Zero allocated memory POPR #^M<R2,R3,R4,R5> ;Initialize FAB BLOCK ;R5 = Address of input filename ;R6 = Length of input filename ;R7 = Address of output filename buffer ;R8 = Length of output filename buffer ;R9 = Address of FAB/NAM BLOCK ADDL3 #FAB$C_BLN,R9,R10 ;R10 = Address of NAM block MOVB #FAB$C_BID,FAB$B_BID(R9) ;FAB block ID # MOVB #FAB$C_BLN,FAB$B_BLN(R9) ;FAB block length MOVL R10,FAB$L_NAM(R9) ;NAM block address MOVL R5,FAB$L_FNA(R9) ;Address of string containing file name MOVB R6,FAB$B_FNS(R9) ;Length of string containing file name ;Initialize NAM block ;R2 - If odd then use physical device names MOVB #NAM$C_BID,NAM$B_BID(R10) ;NAM block ID # MOVB #NAM$C_BLN,NAM$B_BLN(R10) ;NAM block length MOVL R7,NAM$L_ESA(R10) ;Expanded file name string address MOVB R8,NAM$B_ESS(R10) ;Expanded file name string size BISB2 #NAM$M_SYNCHK,NAM$B_NOP(R10) ;Parse only BLBC R2,2$ ;Branch else use physical device names BISB2 #NAM$M_NOCONCEAL,NAM$B_NOP(R10) ;Translate resultant file name using physical device names ;Parse the filename 2$: $PARSE FAB=(R9) ;Parse the filename MOVZBL NAM$B_ESL(R10),R1 ;Move expanded filename length to R1 RET ;Parse status in R0, filename length in R1 ;------------------------------------------------------------------------------ ;============================================================================== ; MISCELLANEOUS ;============================================================================== .SUBTITLE EDX_SETDEF ;++ ; ; Functional Description: ; This procedure changes a user's default directory. ; ; Calling Sequence: ; CALLS #0,EDX_SETDEF ; ; Argument inputs: ; INSTR = Address of descriptor of string containing new directory to go to ; ; Outline: ; 1. Memory is allocated on the stack to use for FAB/NAM BLOCK ; 2. The FAB and NAM blocks are initialized ; 3. The filespec is parsed ; 4. The node and disk are extracted and SYS$DISK is defined ; 4. Call SYS$SETDDIR ; 5. Check return status and signal if error ; ; Memory Map (Memory allocated on stack): ; ; FAB/NAM BLOCK ; -----------------------------------------(start of FAB block) ; | IFI | BLN | BID | 00 (R9 = base address) ; ----------------------------------------- ; | FOP | 04 ; ----------------------------------------- ; | STS | 08 ; ----------------------------------------- ; | STV | 0C ; ----------------------------------------- ; | ALQ | 10 ; ----------------------------------------- ; | SHR | FAC | DEQ | 14 ; ----------------------------------------- ; | CTX | 18 ; ----------------------------------------- ; | RFM | RAT | ORG | RTV | 1C ; ----------------------------------------- ; | | |FACILITY | JOURNAL | 20 ; ----------------------------------------- ; | XAB | 24 ; ----------------------------------------- ; | NAM | 28 ; ----------------------------------------- ; | FNA | 2C ; ----------------------------------------- ; | DNA | 30 ; ----------------------------------------- ; | MRS | DNS | FNS | 34 ; ----------------------------------------- ; | MRN | 38 ; ----------------------------------------- ; | FSZ | BKS | BLS | 3C ; ----------------------------------------- ; | DEV | 40 ; ----------------------------------------- ; | SDC | 44 ; ----------------------------------------- ; | RCF | ACMODES | GBC | 48 ; ----------------------------------------- ; | | | | | 4C ; ----------------------------------------- (start of NAM block) ; | RSL | RSS | BLN | BID | 00 + FAB$C_BLN (= R10) ; ----------------------------------------- ; | RSA | 04 ; ----------------------------------------- ; | ESL | ESS | RFS | NOP | 08 ; ----------------------------------------- ; | ESA | 0C ; ----------------------------------------- ; | RLF | 10 ; ----------------------------------------- ; | | | | | 14 ; ----------------------------------------- ; | | | | | 18 ; ----------------------------------------- ; | | | | | 1C ; ----------------------------------------- ; | | | | | 20 ; ----------------------------------------- ; | FID_SEQ | FID_NUM | 24 ; ----------------------------------------- ; | DID | FID_NBX | FID_RVN | 28 ; ----------------------------------------- ; | DID_NMX | DID_RVN | DID_SEQ | 2C ; ----------------------------------------- ; | WCC | 30 ; ----------------------------------------- ; | FNB | 34 ; ----------------------------------------- ; | NAME | DIR | DEV | NODE | 38 ; ----------------------------------------- ; | | | VER | TYPE | 3C ; ----------------------------------------- ; | NODE | 40 ; ----------------------------------------- ; | DEV | 44 ; ----------------------------------------- ; | DIR | 48 ; ----------------------------------------- ; | NAME | 4C ; ----------------------------------------- ; | TYPE | 50 ; ----------------------------------------- ; | VER | 54 ; ----------------------------------------- ; | | | | | 58 ; ----------------------------------------- ; | | | | | 5C ; -----------------------------------------(expanded file name string returned) ; | EXPANDED FILE NAME STRING | FAB$C_BLN+NAM$C_BLN ; | . | ; | | ; ----------------------------------------- ; | FAB$C_BLN+NAM$C_BLN+BUFLEN ; ;-- .PSECT STATIC RD,NOWRT,NOEXE,LONG,PIC .ALIGN LONG SYS$DISK: .ASCID /SYS$DISK/ ;Logical name table search list to use ;-- .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY EDX_SETDEF ^M<R2,R3,R4,R5,R9,R10> ;Allocate zero filled memory on stack SUBL2 #<FAB$C_BLN+NAM$C_BLN+BUFLEN>,SP ;Allocate memory on stack MOVL SP,R9 ;Store base address. We'll use this memory for the FAB/NAM block MOVC5 #0,(SP),#^x00,#<FAB$C_BLN+NAM$C_BLN>,(R9) ; Zero allocated memory ;Initialize FAB BLOCK ;R9 = Address of FAB BLOCK MOVL INSTR,R0 ;R0 = Address of descriptor ADDL3 #FAB$C_BLN,R9,R10 ;R10 = Address of NAM block MOVB #FAB$C_BID,FAB$B_BID(R9) ;FAB block ID # MOVB #FAB$C_BLN,FAB$B_BLN(R9) ;FAB block length MOVL R10,FAB$L_NAM(R9) ;NAM block address MOVL 4(R0),FAB$L_FNA(R9) ;Address of string containing file name MOVB (R0),FAB$B_FNS(R9) ;Length of string containing file name ;Initialize NAM block ;R10 = Address of NAM BLOCK MOVB #NAM$C_BID,NAM$B_BID(R10) ;NAM block ID # MOVB #NAM$C_BLN,NAM$B_BLN(R10) ;NAM block length ADDL3 #NAM$C_BLN,R10,NAM$L_ESA(R10) ;Expanded file name string address MOVB #NAM$C_MAXRSS,NAM$B_ESS(R10) ;Expanded file name string size ;Parse the filename $PARSE FAB=(R9) ;Parse the filename BLBS R0,2$ ;Branch on success PUSHL R0 ;Error code CALLS #1,EDX_SIGNAL ;Signal error PUSHL #0 ;retcode CALLS #1,FMTOUTSTR ;format return status RET ;Error exit ;Set default disk by defining SYS$DISK as NODE::DISK: ;Build descriptor on stack for NODE::DISK: 2$: PUSHL #0 ;Allocate 2 zero-filled longwords on stack PUSHL #0 ; MOVL SP,R0 ;R0 will be address of descriptor ADDB3 NAM$B_NODE(R10),- NAM$B_DEV(R10),(R0) ;Length of NODE::DISK: BEQL 3$ ;Branch if zero length. Disk not specified. MOVB #DSC$K_DTYPE_T,DSC$B_DTYPE(R0) ;Type MOVB #DSC$K_CLASS_S,DSC$B_CLASS(R0) ;Class MOVL NAM$L_NODE(R10),DSC$A_POINTER(R0) ;Address of NODE::DISK: ;Call LIB$SET_LOGICAL PUSHL R0 ;Address of descriptor of NODE::DISK: PUSHAL SYS$DISK ;Address of descriptor of SYS$DISK CALLS #2,G^LIB$SET_LOGICAL ;Set logical name BLBS R0,3$ ;Branch if success PUSHL R0 ;Otherwise signal error CALLS #1,EDX_SIGNAL ; PUSHL #0 ;retcode CALLS #1,FMTOUTSTR ;format return status RET ;and return error setting sys$disk ;Set default directory 3$: PUSHL #0 ;cur-dir-addr PUSHL #0 ;length-addr PUSHL INSTR ;Address of string descriptor CALLS #3,G^SYS$SETDDIR ;Set default directory PUSHL #1 ;Assume success return status BLBS R0,4$ ;Branch if OK PUSHL #0 ;Change that to a failure return status PUSHL R0 ;Otherwise signal error CALLS #1,EDX_SIGNAL ; 4$: CALLS #1,FMTOUTSTR ;format return status (status already on stack) RET ;return ;------------------------------------------------------------------------------ .SUBTITLE SET LOGICAL ;++ ; ; Functional Description: ; Defines a logical name. The logical name is created in supervisor ; mode and placed in the LNM$PROCESS table. ; ; Calling Sequence: ; CALLS #0,SET_LOGICAL ; ; Argument inputs: ; INSTR = Address of descriptor of input string. String is of the form: ; "log-nam value". It should be a substring of the full DCL ; type command "DEFINE log-nam value". ; ; log-nam = Logical name to be defined or redefined. ; value = Value to be given to the logical name. ; ; Outline: ; 1. The input string is parsed. A descriptor for the substring ; "log-nam" and a descriptor for the substring "value" are made. ; 2. LIB$SET_LOGICAL is called to define the logical name. ; The return status checked and signaled if there is an error. ; ;------------------------------------------------------------------------------ .ENTRY SET_LOGICAL,^M<R2,R3,R4,R5,R6> ;Parse input string. Look for first space. MOVL INSTR,R3 ;R3 = Address of descriptor MOVZWL (R3),R2 ;R2 = Length of string MOVL 4(R3),R4 ;R4 = Address of string LOCC #SPACE,R2,(R4) ;Locate first space in string SUBL2 R0,R2 ;R2 = Length of "log-nam" SKPC #SPACE,R0,(R1) ;Locate first non-space in string ;R0 = Length of "value" ;R1 = Address of "value" ;R2 = Length of "log-nam" ;R4 = Address of "log-nam" ;Build descriptors on stack for "log-nam" and "value" SUBL2 #16,SP ;Allocate 4 longwords on stack MOVL SP,R6 ;R6 will be address of "log-nam" descriptor ADDL3 #8,R6,R5 ;R5 will be address of "value" descriptor MOVW R2,DSC$W_LENGTH(R6) ;Length of "log-nam" MOVB #DSC$K_DTYPE_T,DSC$B_DTYPE(R6) ;Type MOVB #DSC$K_CLASS_S,DSC$B_CLASS(R6) ;Class MOVL R4,DSC$A_POINTER(R6) ;Address of "log-nam" MOVW R0,DSC$W_LENGTH(R5) ;Length of "value" MOVB #DSC$K_DTYPE_T,DSC$B_DTYPE(R5) ;Type MOVB #DSC$K_CLASS_S,DSC$B_CLASS(R5) ;Class MOVL R1,DSC$A_POINTER(R5) ;Address of "value" ;Call LIB$SET_LOGICAL PUSHL R5 ;Address of descriptor of "value" PUSHL R6 ;Address of descriptor of "log-nam" CALLS #2,G^LIB$SET_LOGICAL ;Set logical name BLBC R0,1$ ;Branch if failure PUSHL #1 ;retcode CALLS #1,FMTOUTSTR ;format return status RET ;Return. Normal exit ;Process error in creating logical name 1$: PUSHL R0 ;Error code CALLS #1,EDX_SIGNAL ;Signal error PUSHL #0 ;retcode CALLS #1,FMTOUTSTR ;format return status RET ;Error exit ;------------------------------------------------------------------------------ .SUBTITLE SET_SYMBOL ;++ ; ; Functional Description: ; Creates a DCL symbol. ; ; Calling Sequence: ; CALLS #0,SET_SYMBOL ; ; Argument inputs: ; INSTR = Address of descriptor of input string. String is of the form: ; "symbol-name0equivalence0tblind" where 0 represents an ascii ; 0 character. ; ; symbol-name = Name to be defined or redefined. ; expression = Expression to be given to the symbol. ; tblind = Indicator of the table which will contain the defined ; symbol. 1=local, 2=global. (See LIB$SET_SYMBOL) ; ; Outline: ; 1. The input string is parsed. A descriptor for the substring ; "symbol-name", a descriptor for the substring "expression", ; and the value of tblind is extracted. ; ; 2. LIB$SET_SYMBOL is called to create the DCL symbol. ; The return status checked and signaled if there is an error. ; ; -----------------------------------------(descriptor for "symbol-name") ; | class | dtype | string length | <^x00> ; ----------------------------------------- ; | buffer address | <^x04> ; -----------------------------------------(descriptor for "expression") ; | class | dtype | string length | <^x08> ; ----------------------------------------- ; | buffer address | <^x0C> ; ----------------------------------------- ; | TBLIND | <^x10> ; ----------------------------------------- ; | <+^x14> ; ;-- .ENTRY SET_SYMBOL,^M<R2,R3,R4,R5,R6,R7,R9> ;R4 = address of symbol-name ;R5 = length of symbol-name ;R6 = address of equivalence ;R7 = length of equivalence ;Parse input string. Look for first null character. MOVL INSTR,R0 ;Address of descriptor MOVL 4(R0),R2 ;R2 = Address of string MOVZWL (R0),R3 ;R3 = Length of string MOVL R2,R4 ;R4 = Address of "symbol-name" LOCC #0,R3,(R2) ;Locate first null in string SUBL3 R0,R3,R5 ;R5 = Length of "symbol-name" ADDL2 R5,R2 ;address of rest of string MOVL R0,R3 ;new remaining length of string INCL R2 ;skip over found null DECL R3 ;skip over found null MOVL R2,R6 ;R6 = Address of "equivalence" LOCC #0,R3,(R2) ;Locate second null in string SUBL3 R0,R3,R7 ;R7 = Length of "equivalence" ADDL2 R7,R2 ;address of rest of string INCL R2 ;R2 = address of tblind byte char ;R2 = address of tblind byte char ;R4 = address of symbol-name ;R5 = length of symbol-name ;R6 = address of equivalence ;R7 = length of equivalence ;Build descriptors on stack for "symbol-name" and "equivalence" SUBL2 #^x14,SP ;Allocate 5 longwords on stack MOVL SP,R9 ;Save address of allocated memory CLRL ^x10(R9) ;Clear space for tblind SUBB3 #^x30,(R2),^x10(R9) ;convert tblind to integer value MOVW R5,DSC$W_LENGTH(R9) ;Length of "symbol-name" MOVB #DSC$K_DTYPE_T,DSC$B_DTYPE(R9) ;Type MOVB #DSC$K_CLASS_S,DSC$B_CLASS(R9) ;Class MOVL R4,DSC$A_POINTER(R9) ;Address of "symbol-name" MOVW R7,<^x08+DSC$W_LENGTH>(R9) ;Length of "expression" MOVB #DSC$K_DTYPE_T,<^x08+DSC$B_DTYPE>(R9) ;Type MOVB #DSC$K_CLASS_S,<^X08+DSC$B_CLASS>(R9) ;Class MOVL R6,<^x08+DSC$A_POINTER>(R9) ;Address of "expression" ;Call LIB$SET_SYMBOL PUSHAL ^x10(R9) ;tblind PUSHAL ^x08(R9) ;"expression" PUSHAL (R9) ;"symbol-name" CALLS #3,G^LIB$SET_SYMBOL ;Set symbol BLBC R0,2$ ;Branch if failure PUSHL #1 ;retcode CALLS #1,FMTOUTSTR ;format return status RET ;Return. Normal exit ;Process error in setting symbol 2$: PUSHL R0 ;Error code CALLS #1,EDX_SIGNAL ;Signal error PUSHL #0 ;retcode CALLS #1,FMTOUTSTR ;format return status RET ;Error exit ;------------------------------------------------------------------------------ .SUBTITLE SHOW LOGICAL ;++ ; ; Functional Description: ; Translates a logical name ; ; Calling Sequence: ; CALLS #0,SHOW_LOGICAL ; ; Argument inputs: ; INSTR = Address of descriptor of logical name to translate ; OUTSTR = Address of output descriptor to place translation string ; ; Outputs: ; OUTSTR = translation of logical name ; ; Outline: ; 1. Memory is allocated on the stack ; 2. Itemlist for call to SYS$TRNLNM is initialized ; 3. SYS$TRNLNM is called to obtain logical name translation ; ; Memory Map (Memory allocated on stack): ; ; -----------------------------------------(String to contain logical name translation) ; | BUFFER | <^x00> (base address is stored in R9) ; | . | ; | . | ; | | ; -----------------------------------------(return length of string containing logical name translation) ; | RETLEN | <BUFLEN> ; -----------------------------------------(item list for sys$trnlnm) ; | LNM$_STRING | BUFLEN | <BUFLEN+^x04> ; ----------------------------------------- ; | Address of BUFFER | <BUFLEN+^x08> ; ----------------------------------------- ; | Address of RETLEN | <BUFLEN+^x0C> ; ----------------------------------------- ; | 0 | <BUFLEN+^x10> ; -----------------------------------------(original stack pointer) ; | <BUFLEN+^x14> ; ;------------------------------------------------------------------------------ .PSECT STATIC RD,NOWRT,NOEXE,LONG,PIC .ALIGN LONG LNM_TABLE: .ASCID /LNM$FILE_DEV/ ;Logical name table search list to use ;------------------------------------------------------------------------------ .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY SHOW_LOGICAL,^M<R9> ;Allocate memory on stack SUBL2 #<BUFLEN+^x14>,SP ;Move stack pointer over memory we claim MOVL SP,R9 ;Store base address. ;Initialize item list MOVW #BUFLEN,<BUFLEN+^x04>(R9) ;Buffer length MOVW #LNM$_STRING,<BUFLEN+^x06>(R9) ;Item code MOVL R9,<BUFLEN+^x08>(R9) ;Address of BUFFER MOVAL <BUFLEN>(R9),<BUFLEN+^x0C>(R9) ;Address of RETLEN CLRL <BUFLEN+^x10>(R9) ;End of item list ;Translate logical name MOVL #LNM$M_CASE_BLIND,-(SP) ;Attr MOVL SP,R0 ;Address of above (by reference) PUSHAL <BUFLEN+^x04>(R9) ;Item list PUSHL #0 ;Access mode PUSHL INSTR ;Address of descriptor of input string containing logical name to translate PUSHAL LNM_TABLE ;Tabnam PUSHL R0 ;Attr (by reference) CALLS #5,G^SYS$TRNLNM ;Translate logical name CLRL (SP)+ ;Restore stack pointer BLBC R0,1$ ;Branch on failure ;Copy translation to output PUSHL R9 ;address of output string MOVZWL <BUFLEN>(R9),R0 ;length of output string PUSHL R0 ;length of output string PUSHL #1 ;retcode CALLS #3,FMTOUTSTR ;format output string RET ;Normal exit ;Process error translating logical name 1$: PUSHL R0 ;Error code CALLS #1,EDX_SIGNAL ;Signal error PUSHL #0 ;retcode CALLS #1,FMTOUTSTR ;format return status RET ;Error exit ;------------------------------------------------------------------------------ .SUBTITLE SHOW SYMBOL ;++ ; ; Functional Description: ; Translates a DCL symbol ; ; Calling Sequence: ; CALLS #0,SHOW_SYMBOL ; ; Argument inputs: ; INSTR = Address of descriptor of symbol to translate ; OUTSTR = Address of output descriptor to place translation string ; ; Outputs: ; OUTSTR = Translation of DCL symbol ; ; Outline: ; 1. Memory is allocated on the stack ; 2. LIB$GET_SYMBOL is called to obtain the symbol translation ; ; Memory Map (Memory allocated on stack): ; ; -----------------------------------------(String to contain symbol name translation) ; | BUFFER | <^x00> (base address is stored in R9) ; | . | ; | . | ; | | ; -----------------------------------------(descriptor for string containing symbol translation) ; | class | dtype | string length | <BUFLEN> ; ----------------------------------------- ; | buffer address | <BUFLEN+^x04> ; ----------------------------------------- ; | TBLIND | <BUFLEN+^x08> ; -----------------------------------------(original stack pointer) ; | <BUFLEN+^x0C> ; ;-- .ENTRY SHOW_SYMBOL,^M<R9> ;Allocate memory on stack SUBL2 #<BUFLEN+^x0C>,SP ;Move stack pointer over memory we claim MOVL SP,R9 ;Store base address. ;Initialize descriptor MOVW #BUFLEN, <BUFLEN+DSC$W_LENGTH >(R9) ;Length MOVB #DSC$K_DTYPE_T, <BUFLEN+DSC$B_DTYPE >(R9) ;Type MOVB #DSC$K_CLASS_S, <BUFLEN+DSC$B_CLASS >(R9) ;Class MOVL R9, <BUFLEN+DSC$A_POINTER>(R9) ;Address ;Translate DCL symbol PUSHAL <BUFLEN+^x08>(R9) ;Table indicator PUSHAW <BUFLEN>(R9) ;Return length PUSHAL <BUFLEN>(R9) ;Return buffer PUSHL INSTR ;Address of descriptor of DCL symbol to translate CALLS #4,G^LIB$GET_SYMBOL ;Translate symbol BLBC R0,1$ ;Branch on failure ;Copy translation to output PUSHL R9 ;address of output string MOVZWL <BUFLEN>(R9),R0 ;length of output string PUSHL R0 ;length of output string PUSHL <BUFLEN+^x08>(R9) ;retcode CALLS #3,FMTOUTSTR ;format output string RET ;Normal exit ;Process error translating DCL symbol 1$: PUSHL R0 ;Error code CALLS #1,EDX_SIGNAL ;Signal error PUSHL #0 ;retcode CALLS #1,FMTOUTSTR ;format return status RET ;Error exit ;------------------------------------------------------------------------------ .SUBTITLE DELETE FILE ;++ ; ; Functional Description: ; Deletes the specified file. ; ; Calling Sequence: ; CALLS #0,DELETE_FILE ; ; Argument inputs: ; INSTR = Address of descriptor of filename to delete ; ;-- .ENTRY DELETE_FILE,^M<> PUSHAQ @INSTR CALLS #1,G^LIB$DELETE_FILE BLBC R0,1$ ;Branch on failure PUSHL #1 ;retcode CALLS #1,FMTOUTSTR ;format output string RET ;Normal return ;Process error deleting file 1$: PUSHL R0 ;Error code CALLS #1,EDX_SIGNAL ;Signal error PUSHL #0 ;retcode CALLS #1,FMTOUTSTR ;format output string RET ;Error exit .SUBTITLE TRA_EBC_ASC ;++ ; ; Functional Description: ; Translates EBCDIC to ASCII ; ; Calling Sequence: ; CALLS #0,TRA_EBC_ASC ; ; Argument inputs: ; INSTR = Address of input descriptor of EBCDIC string ; OUTSTR = Address of output descriptor to place ASCII string ; ; Outputs: ; OUTSTR = ASCII translation of input string ; ; Outline: ; 1. Memory is allocated on the stack ; 2. LIB$TRA_EBC_ASC is called to obtain the translation string ; ; Memory Map (Memory allocated on stack): ; ; -----------------------------------------(String to contain translation) ; | BUFFER | <^x00> (base address is stored in R9) ; | . | ; | . | ; | | ; -----------------------------------------(descriptor for string containing symbol translation) ; | class | dtype | string length | <MAXLEN> ; ----------------------------------------- ; | buffer address | <MAXLEN+^x04> ; ----------------------------------------- ;-- .ENTRY TRA_EBC_ASC,^M<> ;Allocate memory on stack SUBL2 #<MAXLEN+^x08>,SP ;Move stack pointer over memory we claim MOVL SP,R9 ;Store base address. ;Initialize descriptor MOVW @INSTR, <MAXLEN+DSC$W_LENGTH >(R9) ;Length MOVB #DSC$K_DTYPE_T, <MAXLEN+DSC$B_DTYPE >(R9) ;Type MOVB #DSC$K_CLASS_S, <MAXLEN+DSC$B_CLASS >(R9) ;Class MOVL R9, <MAXLEN+DSC$A_POINTER>(R9) ;Address PUSHAQ <MAXLEN>(R9) ;output buffer PUSHAQ @INSTR ;input string CALLS #2,G^LIB$TRA_EBC_ASC ;translate string BLBC R0,1$ ;Branch on failure ;Copy translation to output PUSHL R9 ;address of output string MOVZWL <MAXLEN>(R9),R0 ;length of output string PUSHL R0 ;length of output string PUSHL #1 ;retcode CALLS #3,FMTOUTSTR ;format output string RET ;Normal exit ;Process error 1$: PUSHL R0 ;Error code CALLS #1,EDX_SIGNAL ;Signal error PUSHL #0 ;retcode CALLS #1,FMTOUTSTR ;format output string RET ;Error exit ;------------------------------------------------------------------------------ .SUBTITLE TRA_ASC_EBC ;++ ; ; Functional Description: ; Translates ASCII to EBCDIC ; ; Calling Sequence: ; CALLS #0,TRA_ASC_EBC ; ; Argument inputs: ; INSTR = Address of input descriptor of ASCII string ; OUTSTR = Address of output descriptor to place EBCDIC string ; ; Outputs: ; OUTSTR = EBCDIC translation of input string ; ; Outline: ; 1. Memory is allocated on the stack ; 2. LIB$TRA_ASC_EBC is called to obtain the translation string ; ; Memory Map (Memory allocated on stack): ; ; -----------------------------------------(String to contain translation) ; | BUFFER | <^x00> (base address is stored in R9) ; | . | ; | . | ; | | ; -----------------------------------------(descriptor for string containing symbol translation) ; | class | dtype | string length | <MAXLEN> ; ----------------------------------------- ; | buffer address | <MAXLEN+^x04> ; ----------------------------------------- ;-- .ENTRY TRA_ASC_EBC,^M<> ;Allocate memory on stack SUBL2 #<MAXLEN+^x08>,SP ;Move stack pointer over memory we claim MOVL SP,R9 ;Store base address. ;Initialize descriptor MOVW @INSTR, <MAXLEN+DSC$W_LENGTH >(R9) ;Length MOVB #DSC$K_DTYPE_T, <MAXLEN+DSC$B_DTYPE >(R9) ;Type MOVB #DSC$K_CLASS_S, <MAXLEN+DSC$B_CLASS >(R9) ;Class MOVL R9, <MAXLEN+DSC$A_POINTER>(R9) ;Address PUSHAQ <MAXLEN>(R9) ;output buffer PUSHAQ @INSTR ;input string CALLS #2,G^LIB$TRA_ASC_EBC ;translate string BLBC R0,1$ ;Branch on failure ;Copy translation to output PUSHL R9 ;address of output string MOVZWL <MAXLEN>(R9),R0 ;length of output string PUSHL R0 ;length of output string PUSHL #1 ;retcode CALLS #3,FMTOUTSTR ;format output string RET ;Normal exit ;Process error 1$: PUSHL R0 ;Error code CALLS #1,EDX_SIGNAL ;Signal error PUSHL #0 ;retcode CALLS #1,FMTOUTSTR ;format output string RET ;Error exit ;============================================================================== .SUBTITLE ENCRYPT_INIT ;++ ; ENCRYPT_INIT ; ; Functional Description: ; ENCRYPT_INIT initializes the Data Encryption Standard algorithm. ; The input password is hashed into a quadword KEY value and a ; quadword RANBITS value. These values are then used to initialize ; the Data Encryption Standard algorithm. ; ; Calling Sequence: ; CALLS #1,ENCRYPT_INIT ; ; Input: ; 4(AP) - PASSWORD character string. (by descriptor, read access) ; ; Memory Map (Memory allocated on stack): ; ; ----------------------------------------- ; | KEY | 00 (R9) ; - - ; | | ; ----------------------------------------- ; ;-- .PSECT DATA RD,WRT,NOEXE,LONG,PIC,NOSHR .ALIGN LONG RANBITS: .QUAD 0 ;-- .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY ENCRYPT_INIT, ^M<R9> SUBL2 #8,SP ;Allocate memory for KEY MOVL SP,R9 ;Store address in R9 PUSHAL RANBITS ;Address of RANBITS PUSHL R9 ;Address of KEY PUSHL INSTR ;Address of PASSWORD descriptor CALLS #3,HCKPWD ;Hash the password into KEY and RANBITS PUSHL R9 ;Address of KEY CALLS #1,DES_INIT ;Initialize DES algorithm PUSHL #1 ;retcode CALLS #1,FMTOUTSTR ;format return status RET ;----------------------------------------------------------------------------- ;++ ; ENCRYPT ; ; Functional Description: ; Encrypts the input string using the Data Encryption Standard in ; output feedback mode. ; ; Calling Sequence: ; CALLS #0,ENCRYPT ; ; Argument inputs: ; INSTR = Address of input descriptor of ASCII string to encrypt ; ; Outputs: ; OUTSTR = Address of output descriptor of encrypted string ; ; Outline: ; 1. Memory is allocated on the stack ; 2. Copy INSTR to allocated memory ; 3. XOR characters with random bits from DES (in longword chunks) ; 4. Return encrypted string ; ; Memory Map (Memory allocated on stack): ; ; -----------------------------------------(string) ; | BUFFER | <^x00> (base address is stored in R9) ; | . | ; | . | ; | | ; ----------------------------------------- ; | <MAXLEN+8> ; ;-- .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY ENCRYPT,^M<R2,R3,R9> ;Test for zero length string 1$: TSTW @INSTR ;Length in descriptor BNEQ 2$ ;continue if not zero length BRW 100$ ;else length was zero and exit ;Allocate memory on stack 2$: SUBL2 #<MAXLEN+8>,SP ;Move stack pointer over memory we claim MOVL SP,R9 ;Store base address. ;Copy string to buffer MOVL INSTR,R0 ;address of descriptor MOVC3 (R0),@4(R0),(R9) ;move password to our buffer ;XOR string with random numbers MOVZWL @INSTR,R2 ;Length of string DIVL3 #4,R2,R2 ;number of 4-byte chunks in string CLRL R3 ;Number of 4-byte chunks processed so far 30$: PUSHAQ RANBITS ;output (quadword) PUSHAQ RANBITS ;input (quadword) CALLS #2,DES_ENCRYPT ;Get new quadword of random bits from DES XORL2 RANBITS,(R9)[R3] ;character = random_number+character INCL R3 ; XORL2 RANBITS+4,(R9)[R3] ;character = random_number+character 31$: AOBLEQ R2, R3, 30$ ;Loop ;Return encrypted string 100$: PUSHL R9 ;address of output string MOVZWL @INSTR,-(SP) ;length of output string PUSHL #1 ;retcode CALLS #3,FMTOUTSTR ;format output string RET ;----------------------------------------------------------------------------- .SUBTITLE HACK_PASSWORD ;++ ; THE PASSWORD HASHING ALGORITHM ; ; The algorithm used to smash the password into a quadword KEY value and ; a quadword RANBITS consists of several different applications of the ; basic Cyclic Redundancy Check (CRC). The the theory of "primitive ; polynomials modulo 2" lies behind the success of using CRCs to hash ; passwords. ; ; ; EXAMPLE OF CRC CALCULATION: ; ; A CRC (Cyclic Redundancy Check) is basically longhand synthetic ; division of two polynomials under modulo two arithmetic. Below ; is an example: ; ; 1x^3 + 1x^2 + 0x + 1 1 1 0 1 ; ------------------------------------ ------------- ; 1x^2 + 0x + 1 | 1x^5 + 1x^4 + 1x^3 + 0x^2 + 1x + 0 1 0 1 | 1 1 1 0 1 0 ; 1x^5 + 0x^4 + 1x^3 1 0 1 ; ---------------------------------- ----------- ; 1x^4 + 0x^3 + 0x^2 + 1x + 0 1 0 0 1 0 ; 1x^4 + 0x^3 + 1x^2 1 0 1 ; --------------------------- --------- ; 0x^3 + 1x^2 + 1x + 0 0 1 1 0 ; 1x^2 + 0x + 1 1 0 1 ; ------------- ----- ; 1x + 1 1 1 ; ; When calculating a CRC, the divisor (1 0 1 above) is the CRC ; polynomial, the dividend (1 1 1 0 1 0 above) is the fixed or ; variable length input bit stream, and the remainder (1 1 above) ; is the CRC we seek. We do not require the quotient (1 1 0 1 above). ; ; The division to find the remainder can be described as follows: ; ; 1. Align the coefficient of the highest degree term of ; the divisor and the coefficient of the highest degree ; term of the dividend and subtract (the same as addition, ; or XORing.) ; ; 2. Align the coefficient of the highest degree term of ; the divisor and the coefficient of the highest degree ; term of the dividend and subtract again. ; ; 3. Repeat the process until the difference has lower ; degree than the divisor. The difference is the remainder. ; ; ; Choosing a primitive polynomial for the CRC polynomial is what gives ; the CRC it's power. ; ; By viewing the password character string as a long bit stream ; representing the dividend of a CRC calculation, the CRC may be ; used to convert a password into a pseudo-random remainder value. ; ; Reference: ; Peterson, W.W., and D.T. Brown.: "Cyclic Codes for Error Detection". ; Proc. IRE, vol. 49, pp. 228-235, Jan. 1961. ; ;----------------------------------------------------------------------------- ; ; MACROS: ; GENBITS ; A variation of the CRC calculation can be used to generate a ; random bit stream. Instead of feeding in bits from a password ; string, the bits popped off the high end of the shift register ; are fed back into the low end. If the CRC is using a primitive ; polynomial of degree n as the divisor, then this recurrence ; relation is guaranteed to cycle through all possible sequences ; of n bits (except all zeros) before it repeats. ; ; Reference: ; NUMERICAL RECIPES: The Art of Scientific Computing, by ; William H. Press, Brian P. Flannery, Saul A. Teukolsky, ; and William T. Vetterling. 1986 Cambridge University Press. ; ; Register usage: ; R0,R1 - holds CRC calculation ; R3 - bit flags: bit#0 set if low bit of byte_9 is set ; bit#1 set if high bit of R1 is set ; R4 - loop control counter .MACRO GENBITS count,hreg,mask,?L1,?L2,?L3 MOVL count,R4 ;Loop counter L1: BBC #31,hreg,L2 ;Test bit about to be shoved off BBSS #0,R3,L2 ;Set flag indicating bit was set L2: ASHQ #1,R0,R0 ;Shift R0,R1 BBCC #0,R3,L3 ;Test if high bit of quad R0R1 was set XORL2 #CRC_MASK2,R0 ;Do XOR. This line should have used #mask instead ;;;; XORL2 #mask,R0 ; of #CRC_MASK2 due to a blunder. L3: SOBGTR R4,L1 ; .ENDM ; ;----------------------------------------------------------------------------- ;++ ; HCKPWD ; ; Functional Description: ; Converts a character string containing a password to two 64-bit ; quadword values. ; ; Calling Sequence: ; CALLS #3,HCKPWD ; ; Input: ; 4(AP) - PASSWORD character string. (by descriptor, read access) ; 8(AP) - KEY quadword, write access, by reference. ; 12(AP) - RANBITS quadword, write access, by reference. ; ; Outputs: ; 8(AP) - KEY a 64 bit quadword pseudo-random bit pattern. ; 12(AP) - RANBITS a 64 bit quadword pseudo-random bit pattern. ; ; Outline: ; 1. A 32 bit pseudo-random bit pattern is generated by passing ; the password character string through a CRC calculation ; using the AUTODIN-II polynomial. (This is the same way ; user login passwords are encrypted and stored.) ; ; 2. The 32 bit pseudo-random bit pattern is used as the seed ; for a random bit generator which is used to generate a ; 64 bit quadword of random bits. ; ; 3. The 64 bit quadword of random bits is used as the seed value ; for a CRC which is performed on the password character ; string. ; ; 4. The 64 bit quadword remainder of the CRC calculated in ; step 3 is returned as the KEY value used for initializing ; the DES algorithm. It is also used as the seed for a random ; bit generator which is used to generate another 64 bit pseudo- ; random quadword which is used as the initial value to start the ; the DES algorithm in output feedback mode. ; ; Register usage: ; ; R0,R1 - holds CRC calculation ; R2 - holds byte_9 ; R3 - bit flags: bit#0 set if low bit of byte_9 is set. ; bit#1 set if high bit of R1 is set ; R4 - loop control counter. ; R5 - counts number of characters in password processed so far ; R6 - length of password character string ; R7 - address of password character string ;-- CRC_MASK1 = ^B010101111 ;x^32+x^7+x^5+x^3+x^2+x^1+1 ;Primitive polynomial CRC_MASK2 = ^B000011011 ;x^64+x^4+x^3+x^1+1 ;Primitive polynomial .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY HCKPWD,^M<R2,R3,R4,R5,R6,R7> PUSHL INSTR ;password CALLS #1,AUTODIN_CRC ;Do CRC to get 32 pseudo-random bits in R0 GENBITS #32,R0,CRC_MASK1 ;Expand 32 bits in R0 to 64 bits in R0,R1 ;STEP 3. ;Do CRC on PASSWORD to get 64 bits in R0, R1 BSBW PSWD_CRC ;STEP 4. MOVQ R0,@8(AP) ;output RO,R1 as KEY GENBITS #64,R1,CRC_MASK2 ;generate 64 more random bits MOVQ R0,@12(AP) ;output R0,R1 as RANBITS RET ;----------------------------------------------------------------------------- .SUBTITLE AUTODIN_CRC ;++ ; AUTODIN_CRC ; ; Functional Description: ; Perform cyclic redundancy check on input character string PASSWORD ; creating a 32 bit pseudo-random longword. ; ; Calling Sequence: ; CALLS #1,AUTODIN_CRC ; ; Argument inputs: ; 4(AP) = Address of descriptor of PASSWORD string. ; ; Outputs: ; R0 = 32 bit pseudo-random longword. ; ; Outline: ; The VAX CRC (Cyclic Redundancy Check) instruction is used to ; calculate the CRC of the input PASSWORD using the AUTODIN-II ; polynomial. ; ;-- ; ; Description of CRC instruction setup: ; ; The polynomial used is: 1 + x^2 + x^4 + x^5 + x^7 + x^8 + x^10 + x^11 + x^12 + x^16 + x^22 + x^23 + x^26 + x^32 ; The binary representation is: 1101 1011 1000 0000 0001 0000 0000 1 ; Expressed in hex is: ^xEDB88320 ; (This is the AUTODIN-II polynomial which is also used by VMS to hash ; a user's login password.) ; ; A full picture of how this is done is given below. First the entire ; polynomial is written in expanded form. (Note that the CRC instruction ; takes bits off from the right, thus the right most bit represents the high ; order coefficients of x^n and the bits on the far left represent the low ; order coefficients of x^0. This is why the polynomial is written down ; backwards.) ; 1x^0 + 1x^1 + 1x^2 + 0x^3 + 1x^4 + 1x^5 + 0x^6 + 1x^7 + 1x^8 + 0x^9 + 1x^10 + 1x^11 + 1x^12 + 0x^13 + 0x^14 + 0x^15 + 1x^16 + 0x^17 + 0x^18 + 0x^19 + 0x^20 + 0x^21 + 1x^22 + 1x^23 + 0x^24 + 0x^25 + 1x^26 + 0x^27 + 0x^28 + 0x^29 + 0x^30 + 0x31 + 1x^32 ; ; Then just the coefficients of the polynomial are extracted: ; 1 1 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 0 0 0 0 0 1 1 0 0 1 0 0 0 0 0 1 ; ; The 1 at the far right representing 1x^32 is dropped, and the remaining ; coefficients together represent a binary number. The binary number is ; converted to hexadecimal for convenience. ;| E | D | B | 8 | 8 | 3 | 2 | 0 | ; ; The resulting hexadecimal number is EDB88320. This is the value POLY used ; by LIB$CRC_TABLE to create the crc-table which is needed by the CRC ; instruction. ; ;-- .ENTRY AUTODIN_CRC, ^M<> SUBL2 #<16*4>,SP ;Allocate 16 longwords on stack for CRC_TABLE PUSHL SP ;Address of CRC_TABLE PUSHAL #^xEDB88320 ;AUTODIN-II polynomial CALLS #2,G^LIB$CRC_TABLE ;Calculate CRC-TABLE MOVQ @4(AP),R0 ;Descriptor. R0 = length, R1 = address CRC (SP),#-1,R0,(R1) ;Do CRC. Result is left in R0 RET ;----------------------------------------------------------------------------- .SUBTITLE PSWD_CRC ;++ ; PSWD_CRC ; ; Functional Description: ; Perform cyclic redundancy check on input character string PASSWORD ; creating a 64 bit pseudo-random quadword. ; ; Calling Sequence: ; JSB PSWD_CRC ; ; Argument inputs: ; R0,R1 - Initial value for CRC ; ; Outputs: ; R0,R1 - Final value of CRC calculation. A 64 bit random value. ; ; Outline: ; The basic flow diagram is shown below. The password character ; string is viewed as a long bit stream representing the dividend ; polynomial. Characters are taken one at a time from the password ; and placed in the low byte of R2, hereinafter referred to as byte_9. ; Shifting is then done in a manner which maintains the integrity of ; the bit stream: ; 1. The quadword formed by R0 and R1 is left shifted one bit. ; 2. Byte_9 is right shifted one byte. ; 3. The low bit of byte_9 that was pushed off moves to ; the low bit of R0. ; ; If the high bit pushed off R1 was a '1' then we subtract (XOR) ; the divisor (our primitive polynomial) from the quadword R0,R1 ; (which contains the high 64 bits of our remainder so far). ; ; The process is repeated until the password is exhausted, and the last ; bit from the password has shifted off the high end of R1. ; ; PASSWORD --- ; | ; V ; ; ---> ; R2 | byte_9 | ; | .3....v....2....v....1....v....0 | ; | ; <------ v ; R1 R0 ; 64 | ...6....v....5....v....4....v....3....v....2....v....1....v....0 | ; 1 11 11 = x^64+x^4+x^3+x^1+1 ; ; ; Register usage: ; ; R0,R1 - holds CRC calculation ; R2 - holds byte_9 ; R3 - bit flags: bit#0 set if low bit of byte_9 is set. ; bit#1 set if high bit of R1 is set ; R4 - loop control counter. ; R5 - counts number of characters in password processed so far ; R6 - length of password character string ; R7 - address of password character string ; ;-- PSWD_CRC: MOVQ @4(AP),R6 ;descriptor to R6,R7. R7 = address MOVZWL R6,R6 ;length of string CLRL R3 ;clear bit flags CLRL R5 ;initialize loop counter 100$: MOVB (R7)[R5],R2 ;move next byte from character string to byte_9 MOVZBL #8,R4 ;loop 8 times for 8 bits in byte_9 120$: BBC #31,R1,130$ ;test bit about to be shoved off BBSS #0,R3,130$ ;set flag indicating high bit of quad R0R1 was set 130$: BLBC R2,140$ ;test bit about to be shoved off of byte_9 BBSS #1,R3,140$ ;set flag indicating low bit of byte_9 was set 140$: ASHQ #1,R0,R0 ;shift R0,R1 ASHL #-1,R2,R2 ;shift byte_9 BBCC #1,R3,150$ ;test if low bit of byte_9 was set INCL R0 ;set low bit of quad R0R1 150$: BBCC #0,R3,160$ ;test if high bit of quad R0R1 was set XORL2 #CRC_MASK2,R0 ;do XOR 160$: SOBGTR R4,120$ ;loop until 8 bits in byte_9 exhausted AOBLSS R6,R5,100$ ;loop until all password characters exhausted GENBITS #64,R1,CRC_MASK2 ;finish off CRC RSB ;----------------------------------------------------------------------------- .SUBTITLE DES DATA ENCRYPTION STANDARD ;++ ; AMERICAN NATIONAL STANDARD DATA ENCRYPTION ALGORITHM ; American National Standard X3.92-1981 ; ; Functional Description: ; This subsection implements the Data Encryption Standard (DES) ; for encrypting data. It is self contained and may be extracted ; for use in your own programs. ; ; It consists of two routines, DES_INIT and DES_ENCRYPT. DES_INIT ; must be called first to initialize the encryption algorithm with ; the KEY which is used to encipher and decipher the data. After ; initializing the encryption algorithm with KEY, subsequent calls ; may be made to DES_ENCRYPT to encrypt or decrypt data. ; ; FORTRAN Example: ; INTEGER*4 KEY(2),INPUT(2),OUTPUT(2) ; CALL DES_INIT(KEY) !Initialize ; CALL DES_ENCRYPT(INPUT,OUTPUT) !Encrypt data ; CALL DES_ENCRYPT(INPUT,OUTPUT,%VAL(1)) !Decrypt data ; ; References: ; "Data Encryption Standard", 1977 January 15, Federal Information ; Processing Standards Publication, number 46 (Washington: U.S. ; Department of Commerce, National Bureau of Standards). ; ; "DES Modes of Operation", 1980 December 2, Federal Information ; Processing Standards Publication, number 81 (Washington: U.S. ; Department of Commerce, National Bureau of Standards). ; ;-- ; ; MACRO DEFINITIONS: ; ; The literature for DES numbers bits backwards from the way VAX ; architecture numbers bits. DES numbers bits by starting at the ; left with the most significant bit and numbering them 1,2,3... ; ending with the least significant bit. ; ; VAX architecture numbers bits starting at the right with the least ; significant bit and numbering them 0,1,2,3... ending at the left ; with the most significant bit. ; ; Below is an example of how DES and VAX numbers the bits for a ; 32 bit longword. The numbering is similar for quadwords and ; variable length bit fields in general. ; ; 1 2 3 ... 30 31 32 DES bit numbering ; ---------------------------------------- ; | | ; ---------------------------------------- VAX bit numbering ; 31 30 29 ... 2 1 0 ; ; In the following discussions, bit# refers to the VAX bit numbering ; scheme, and bit without the # refers to the DES indicated bit number. ; For example, bit#5 refers to VAX bit numbering, and bit 5 refers ; to DES bit numbering. ; ; ; BITDATA ; This macro converts data indicating bit positions from the DES ; bit numbering scheme to the VAX bit numbering scheme. The first ; parameter, nbits, is the number of bits in the bit field. Following ; parameters are the DES bit number data. ; ; Data is converted from the DES bit numbering scheme to the VAX bit ; numbering scheme using the formula: ; vaxbit# = (num_bits_in_field - DES_bit_number) ; .MACRO BITDATA nbits, - n1,n2,n3,n4,n5,n6,n7,n8,n9,n10,n11,n12,n13,n14,n15,n16 .IRP num,<n1,n2,n3,n4,n5,n6,n7,n8,n9,n10,n11,n12,n13,n14,n15,n16> .IIF NOT_BLANK, num, .BYTE <nbits-num> .ENDR .ENDM BITDATA ; ; ; PERMUTE ; This macro takes bits from IN and moves them to OUT in a shuffled ; order. DATA is a stream of data bytes indicating the bit order ; bits from IN are to be chosen. For example, if DATA = 58,50,42,... ; then first bit 58 from IN is copied to bit 1 of OUT, then bit 50 ; from IN is copied to bit 2 of OUT, then bit 42 from IN is copied ; to bit 3 of OUT, etc. ; ; For proper functioning, DATA must first be converted from the DES ; bit numbering scheme to the VAX bit numbering scheme using the ; BITDATA macro. Also, since DES bit 1 is actually the highest most ; significant bit, we start with the highest most significant bit ; on OUT, and work our way down towards the right most least significant ; bit. ; ; This macro uses R0,R1. ; .MACRO PERMUTE in, out, data, nbits, ?L1, ?L2 SUBL3 #1,nbits,R0 ;Initialize loop counter CLRQ out ;clear output quadword L1: SUBL3 R0,nbits,R1 ;get index into data (index goes from 0 to nbits-1) DECL R1 ;. MOVZBL data[R1],R1 ;R1=bit number to get BBC R1,in,L2 ;Branch if input bit clear BBSS R0,out,L2 ;else set corresponding output bit L2: SOBGEQ R0,L1 ;Loop .ENDM ;-- ;++ ; DES_INIT ; ; Functional Description: ; This routine initializes the data encryption algorithm using the ; input quadword KEY. Using KEY it calculates the sixteen 48 bit ; sub-master keys SUBKEY(1)-SUBKEY(16) and stores them in memory ; array DES_SUBKEY. ; ; Calling Sequence: ; CALLS #1,DES_INIT ; ; Input: ; 4(AP) - KEY a 64 bit quadword value (by reference, read access) ; ; Outline: ; 1. 56 of the 64 bits of input quadword KEY are used to create CnDn. ; DES_PMC1 (Permuted Choice 1) data dictates how this is done. Bit ; 57 (DES numbering) of KEY becomes the first bit (bit 1, DES numbering) ; of CnDn, bit 49 of KEY becomes the second bit of CnDn, bit 41 of KEY ; becomes the third bit of CnDn, etc. ; ; 2. The first 28 bits of CnDn (bit#55-bit#28) become Cn. The second 28 ; bits of CnDn (bit#27-bit#0) become Dn. ; ; 3. Cn is left shifted (actually left rotated, bits move from lower ; to higher, with bit#28 moving to bit#0). Cn is rotated by two bit ; positions, except for N={1,2,9,16}, in which case Cn is rotated by ; one bit position. (n = N-1 before rotating, n = N after rotating, ; n=0 to start). ; ; 4. Step 3 is repeated for Dn. ; ; 5. Cn and Dn are recombined to create CnDn. ; ; 6. 48 of the 56 bits of this new CnDn are used to create SUBKEY(N). ; DES_PMC2 (Permuted Choice 2) data dictates how this is done. Bit ; 14 (DES bit numbering) of CnDn becomes the first bit (bit 1, DES ; bit numbering) of SUBKEY(N), bit 17 of CnDn becomes the second bit ; of SUBKEY(N), bit 11 of CnDn becomes the third bit of SUBKEY(N), etc. ; ; 7. Repeat steps 2,3,4,5,6 until all 16 SUBKEYs have been generated. ; Only the 16 SUBKEYs are actually used in the encryption algorithm. ; The original KEY is no longer needed. ; ; Memory maps: ; ; DES_SUBKEY (in permanent memory psect DATA) ; -------------------------------------------------------------- ; | SUBKEY(1) (3 words) | 00 + DES_SUBKEY ; -------------------------------------------------------------- ; | SUBKEY(2) (3 words) | 06 ; -------------------------------------------------------------- ; | SUBKEY(3) (3 words) | 0C ; -------------------------------------------------------------- ; | SUBKEY(4) (3 words) | 12 ; -------------------------------------------------------------- ; | SUBKEY(5) (3 words) | 18 ; -------------------------------------------------------------- ; | SUBKEY(6) (3 words) | 1E ; -------------------------------------------------------------- ; | SUBKEY(7) (3 words) | 24 ; -------------------------------------------------------------- ; | SUBKEY(8) (3 words) | 2A ; -------------------------------------------------------------- ; | SUBKEY(9) (3 words) | 30 ; -------------------------------------------------------------- ; | SUBKEY(10) (3 words) | 36 ; -------------------------------------------------------------- ; | SUBKEY(11) (3 words) | 3C ; -------------------------------------------------------------- ; | SUBKEY(12) (3 words) | 42 ; -------------------------------------------------------------- ; | SUBKEY(13) (3 words) | 48 ; -------------------------------------------------------------- ; | SUBKEY(14) (3 words) | 4E ; -------------------------------------------------------------- ; | SUBKEY(15) (3 words) | 54 ; -------------------------------------------------------------- ; | SUBKEY(16) (3 words) | 5A ; -------------------------------------------------------------- ; | 60 ; ; TEMPORARY STORAGE allocated on stack ; ----------------------------------------- ; | CnDn | 00 (R9 = base address) ; - - ; | | 04 ; ----------------------------------------- ; | 08 ;-- .PSECT STATSHR RD,NOWRT,NOEXE,LONG,PIC,SHR .ALIGN LONG DES_PMC1: ;Permuted Choice 1 (table 7) (64 bits to 56) BITDATA 64 57,49,41,33,25,17, 9, 1,58,50,42,34,26,18,10, 2 BITDATA 64 59,51,43,35,27,19,11, 3,60,52,44,36,63,55,47,39 BITDATA 64 31,23,15, 7,62,54,46,38,30,22,14, 6,61,53,45,37 BITDATA 64 29,21,13, 5,28,20,12, 4 .ALIGN LONG DES_PMC2: ;Permuted Choice 2 (table 9) (56 bits to 48) BITDATA 56 14,17,11,24, 1, 5, 3,28,15, 6,21,10,23,19,12, 4 BITDATA 56 26, 8,16, 7,27,20,13, 2,41,52,31,37,47,55,30,40 BITDATA 56 51,45,33,48,44,49,39,56,34,53,46,42,50,36,29,32 ;-- .PSECT DATA RD,WRT,NOEXE,LONG,PIC,NOSHR .ALIGN LONG DES_SUBKEY: .BLKW 16*3 ;Storage for SUBKEY(1)-SUBKEY(16) ;-- .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY DES_INIT ^M<R2,R3,R8,R9,R11> ;Allocate temporary storage on stack SUBL2 #8,SP ;Move SP over memory we claim MOVL SP,R9 ;Store base address in R9 MOVAB DES_SUBKEY,R8 ;To make routine position independent ;STEP 1 ;Initial selection and permutation PERMUTE in=@4(AP), - ;KEY out=(R9), - ;(R9)=CnDn data=DES_PMC1, - ;Permuted Choice 1 nbits=#56 ;Begin loop to generate 16 sub-master keys MOVZBL #1,R11 ;R11 = loop index N ;STEP 2 ;Separate CnDn into two halves Cn and Dn 10$: EXTZV #0,#28,(R9),R2 ;R2 = Low half CnDn = Dn EXTZV #28,#28,(R9),R3 ;R3 = High half of CnDn = Cn ;STEPS 3,4 ;For most values of N perform two shifts (R0=2) ;except for N={1,2,9,16} perform one shift (R0=1) MOVZBL #2,R0 ;R0 = 2 assume two shifts CMPL R11,#1 ;check for N = 1,2,9,16 BEQL 15$ CMPL R11,#2 BEQL 15$ CMPL R11,#9 BEQL 15$ CMPL R11,#16 BNEQ 25$ 15$: DECL R0 ;R0=1 only one shift ;Rotate Cn and Dn. We only want to rotate bits(0)-(27) 25$: ASHL #1,R3,R3 ;rotate R3 (Cn) BBCC #28,R3,30$ ;Check bit#27 shifted to bit#28. INCL R3 ;set bit#0 if bit#28 was set 30$: ASHL #1,R2,R2 ;Rotate R2 (Dn) BBCC #28,R2,40$ ;Check bit#27 shifted to bit#28 INCL R2 ;set bit#0 if bit#28 was set 40$: SOBGTR R0,25$ ;Loop (on shifts) ;STEP 5 ;Reconstruct CnDn MOVL R2,(R9) ;Put back Dn half (bit#s 0-27) INSV R3,#28,#28,(R9) ;Put back Cn half (bit#s 28-56) ;STEP 6 ;Permute CnDn to SUBKEY(N) MULL3 #6,R11,R2 ;Calculate address of SUBKEY(N) ADDL2 R8,R2 ; SUBL2 #6,R2 ; PERMUTE in=(R9), - ;(R9)=CnDn out=(R2), - ;out=SUBKEY(N) data=DES_PMC2, - ;Permuted Choice 2 nbits=#48 ;STEP 7 AOBLEQ #16,R11,10$ ;Loop (on N) RET ;----------------------------------------------------------------------------- ;++ ; DES_ENCRYPT ; ; Functional Description: ; This routine takes the quadword INPUT and encrypts it using the ; Data Encryption Standard creating the encrypted quadword OUTPUT. ; ; Calling Sequence: ; CALLS #2,DES_ENCRYPT ; or ; CALLS #3,DES_ENCRYPT ; ; Inputs: ; 4(AP) - INPUT a 64 bit quadword value (by reference, read access) ; 8(AP) - OUTPUT a 64 bit quadword value (by reference, write access) ; 12(AP) - DECRYPT OPTIONAL. 0=encrypt(the default) ; 1=decrypt (by value) ; This parameter is optional. ; ; Implicit: ; It is assumed that DES_INIT has already been called to initialize ; the encryption algorithm. ; ; Outline: ; 1. The 64 bits of quadword INPUT are permuted to quadword LNRN ; according to DES_INIPRM data (Initial Permutation IP, table 1, ; see description of PERMUTE macro and BITDATA macro for details). ; ; 2. The low longword of quadword LNRN (bit#0-bit#31, also known ; as RN) is permuted to IE (48 bits) according to DES_EXPFCN data ; (Expansion Function E, table 3, see description of PERMUTE macro ; and BITDATA macro for details). ; ; 3. The 48 bits of IE are eXclusively ORed (XOR) with the 48 bits ; of SUBKEY(1). ; ; 4. The 48 bits of IE are replaced by 32 bits according to DES_SBOX ; data (Selection Function S(1),...,S(8), tables 4 & 6). The details ; are as follows. The 48 bits of IE (bit#0-bit#47) are divided into ; 8 groups of 6 bits each as shown below. Each group of 6 bits then ; is replaced by 4 bits from SBOX data. ; ; 47....42 41....36 35....30 29....24 23....18 17....12 11....6 5....0 IE input (48 bits) ; |||||| |||||| |||||| |||||| |||||| |||||| |||||| |||||| ; SBOX(1) SBOX(2) SBOX(3) SBOX(4) SBOX(5) SBOX(6) SBOX(7) SBOX(8) ; |||| |||| |||| |||| |||| |||| |||| |||| ; 31..28 27..24 23..20 19..16 15..12 11..8 7..4 3..0 IE output (32 bits) ; ; [bit#5 bit#0] = row number of SBOX(8) (starting with row 0) ; [bit#4 bit#3 bit#2 bit#1] = column number of SBOX(8) (starting with column 0) ; ; Here is an example of how this 6-bit-to-4-bit substitution works. ; For the first group of 6 bits, (bit#0-bit#5), bit#0 and bit#5 ; together form a two bit binary number which indicates the row within ; the SBOX(8) data matrix. Bits #1 through bit#4 together form a ; four bit binary number which indicates the column within the SBOX(8) ; matrix. With the row and column indexes determined, the SBOX(8) ; data element is the 4 bit binary number which replaces the group of ; 6 input bits. The other 7 groups of 6 input bits are replaced by ; 4 output bits in a similar matter using SBOX(7)-SBOX(1). ; ; (Note that in this implementation the output bits are stored in ; IE overwriting the input bits. For example, the 4 output bits ; corresponding to the 6 input bits 0-5 of IE are stored in ; IE as bits 0-3, overwriting the no longer needed IE bits 0-5.) ; ; 5. The resulting 32 bits of IE are permuted according to DES_PFP data ; (Permutation Function P, table 5), and then exclusively ORed (XOR) ; with the high longword of quadword LNRN (bit#32-bit#63, also known ; as LN) ; ; 6. The low longword and the high longword of quadword LNRN are swapped. ; ; 7. Steps 2,3,4,5,6 are repeated for a total of 16 times, using ; SUBKEY(2)-SUBKEY(16) in step 3. Step 6 is skipped the last time. ; ; 8. The 64 bits of quadword LNRN are permuted to quadword OUTPUT according ; to DES_INVINIPRM data (Inverse of Initial Permutation IP, table 2, ; see description of PERMUTE macro and BITDATA macro for details). ; ; Memory map: ; ; TEMPORARY STORAGE allocated on the stack ; ----------------------------------------- ; | IE | 00 (R9 = base address) ; - - ; | | 04 ; ----------------------------------------- ; | RN | 08 (LNRN = RN, LN) ; - - - - - - - - - - - - - - - - - - - - - ; | LN | 0C ; ----------------------------------------- ; | 10 ;-- .PSECT STATSHR RD,NOWRT,NOEXE,LONG,PIC,SHR .ALIGN LONG DES_INIPRM: ;Initial Permutation (table 1) (64 bits to 64) BITDATA 64 58,50,42,34,26,18,10, 2,60,52,44,36,28,20,12, 4 BITDATA 64 62,54,46,38,30,22,14, 6,64,56,48,40,32,24,16, 8 BITDATA 64 57,49,41,33,25,17, 9, 1,59,51,43,35,27,19,11, 3 BITDATA 64 61,53,45,37,29,21,13, 5,63,55,47,39,31,23,15, 7 .ALIGN LONG DES_INVINIPRM: ;Inverse of Initial Permutation (table 2) (64 bits to 64) BITDATA 64 40, 8,48,16,56,24,64,32,39, 7,47,15,55,23,63,31 BITDATA 64 38, 6,46,14,54,22,62,30,37, 5,45,13,53,21,61,29 BITDATA 64 36, 4,44,12,52,20,60,28,35, 3,43,11,51,19,59,27 BITDATA 64 34, 2,42,10,50,18,58,26,33, 1,41, 9,49,17,57,25 .ALIGN LONG DES_EXPFCN: ;Expansion Function E (table 3) (32 bits to 48) BITDATA 32 32, 1, 2, 3, 4, 5, 4, 5, 6, 7, 8, 9, 8, 9,10,11 BITDATA 32 12,13,12,13,14,15,16,17,16,17,18,19,20,21,20,21 BITDATA 32 22,23,24,25,24,25,26,27,28,29,28,29,30,31,32, 1 .ALIGN LONG DES_PFP: ;Permutation Function P (table 5) (32 bits to 32) BITDATA 32 16, 7,20,21,29,12,28,17, 1,15,23,26, 5,18,31,10 BITDATA 32 2, 8,24,14,32,27, 3, 9,19,13,30, 6,22,11, 4,25 .ALIGN LONG DES_SBOX: ;Selection Functions (table 4,6) (6 bits to 4) ; S(1) column# 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 ;row# .BYTE 14, 4,13, 1, 2,15,11, 8, 3,10, 6,12, 5, 9, 0, 7 ;00 .BYTE 0,15, 7, 4,14, 2,13, 1,10, 6,12,11, 9, 5, 3, 8 ;01 .BYTE 4, 1,14, 8,13, 6, 2,11,15,12, 9, 7, 3,10, 5, 0 ;10 .BYTE 15,12, 8, 2, 4, 9, 1, 7, 5,11, 3,14,10, 0, 6,13 ;11 ; S(2) column# 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 ;row# .BYTE 15, 1, 8,14, 6,11, 3, 4, 9, 7, 2,13,12, 0, 5,10 ;00 .BYTE 3,13, 4, 7,15, 2, 8,14,12, 0, 1,10, 6, 9,11, 5 ;01 .BYTE 0,14, 7,11,10, 4,13, 1, 5, 8,12, 6, 9, 3, 2,15 ;10 .BYTE 13, 8,10, 1, 3,15, 4, 2,11, 6, 7,12, 0, 5,14, 9 ;11 ; S(3) column# 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 ;row# .BYTE 10, 0, 9,14, 6, 3,15, 5, 1,13,12, 7,11, 4, 2, 8 ;00 .BYTE 13, 7, 0, 9, 3, 4, 6,10, 2, 8, 5,14,12,11,15, 1 ;01 .BYTE 13, 6, 4, 9, 8,15, 3, 0,11, 1, 2,12, 5,10,14, 7 ;10 .BYTE 1,10,13, 0, 6, 9, 8, 7, 4,15,14, 3,11, 5, 2,12 ;11 ; S(4) column# 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 ;row# .BYTE 7,13,14, 3, 0, 6, 9,10, 1, 2, 8, 5,11,12, 4,15 ;00 .BYTE 13, 8,11, 5, 6,15, 0, 3, 4, 7, 2,12, 1,10,14, 9 ;01 .BYTE 10, 6, 9, 0,12,11, 7,13,15, 1, 3,14, 5, 2, 8, 4 ;10 .BYTE 3,15, 0, 6,10, 1,13, 8, 9, 4, 5,11,12, 7, 2,14 ;11 ; S(5) column# 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 ;row# .BYTE 2,12, 4, 1, 7,10,11, 6, 8, 5, 3,15,13, 0,14, 9 ;00 .BYTE 14,11, 2,12, 4, 7,13, 1, 5, 0,15,10, 3, 9, 8, 6 ;01 .BYTE 4, 2, 1,11,10,13, 7, 8,15, 9,12, 5, 6, 3, 0,14 ;10 .BYTE 11, 8,12, 7, 1,14, 2,13, 6,15, 0, 9,10, 4, 5, 3 ;11 ; S(6) column# 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 ;row# .BYTE 12, 1,10,15, 9, 2, 6, 8, 0,13, 3, 4,14, 7, 5,11 ;00 .BYTE 10,15, 4, 2, 7,12, 9, 5, 6, 1,13,14, 0,11, 3, 8 ;01 .BYTE 9,14,15, 5, 2, 8,12, 3, 7, 0, 4,10, 1,13,11, 6 ;10 .BYTE 4, 3, 2,12, 9, 5,15,10,11,14, 1, 7, 6, 0, 8,13 ;11 ; S(7) column# 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 ;row# .BYTE 4,11, 2,14,15, 0, 8,13, 3,12, 9, 7, 5,10, 6, 1 ;00 .BYTE 13, 0,11, 7, 4, 9, 1,10,14, 3, 5,12, 2,15, 8, 6 ;01 .BYTE 1, 4,11,13,12, 3, 7,14,10,15, 6, 8, 0, 5, 9, 2 ;10 .BYTE 6,11,13, 8, 1, 4,10, 7, 9, 5, 0,15,14, 2, 3,12 ;11 ; S(8) column# 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 ;row# .BYTE 13, 2, 8, 4, 6,15,11, 1,10, 9, 3,14, 5, 0,12, 7 ;00 .BYTE 1,15,13, 8,10, 3, 7, 4,12, 5, 6,11, 0,14, 9, 2 ;01 .BYTE 7,11, 4, 1, 9,12,14, 2, 0, 6,10,13,15, 3, 5, 8 ;10 .BYTE 2, 1,14, 7, 4,10, 8,13,15,12, 9, 0, 3, 5, 6,11 ;11 ;-- .PSECT CODE NOWRT,EXE,LONG,PIC,SHR .ENTRY DES_ENCRYPT, ^M<R2,R3,R4,R6,R7,R8,R9,R10,R11> ;Allocate temporary storage on stack SUBL2 #^x10,SP ;Move SP over memory we claim MOVL SP,R9 ;Store base address in R9 MOVAB DES_SUBKEY,R4 ;To make routine position independent ;STEP 1 ;Initial Permutation ;INPUT(64 bits) -> LNRN(64 bits) PERMUTE in=@4(AP), - ;in=INPUT (quadword) out=8(R9), - ;out=LNRN data=DES_INIPRM, - ;data= Initial Permutation IP (table 1) nbits=#64 ;Number of output bits = 64 ; LOOP THROUGH STEPS 2,3,4,5,6 (The 16 stages of encryption) ; R11 - Loop control counter. Counts from 0 to 15 ; R10 - Index N ; For encryption R10 = R11 i.e. N counts from 0 to 15 ; For decryption R10 = 15 - R11 i.e. N counts from 15 to 0 CLRL R11 ;Initialize R11 10$: MOVL R11,R10 ;Assume encryption CMPL (AP),#3 ;See if optional 3rd parameter specified in call BLSS 11$ ;Branch if no third parameter. CMPL 12(AP),#1 ;Test 3rd parameter for decryption BNEQ 11$ ;Branch of not. Encryption. SUBL3 R11,#15,R10 ;R10 = 15 - R11 ;STEP 2 ;Expansion function (permutation) ;RN (of LNRN, 32 bits) -> IE(48 bits) 11$: PERMUTE in=8(R9), - ;in=RN out=(R9), - ;out=IE data=DES_EXPFCN, - ;data= Expansion Function (table 3) nbits=#48 ;Number of output bits = 48 ;STEP 3 ;Add SUBKEY(N) to IE MULL3 #6,R10,R0 ;R0 = offset of SUBKEY(N) ADDL2 R4,R0 ;R0 = Address of SUBKEY(N) XORL2 (R0),(R9) ;IE = IE + SUBKEY(N) XORW2 4(R0),4(R9) ;STEP 4 ; IE(48 bits) -> SBOX -> IE(32 bits) ; ; R8 = Loop control counter b ; for block number 8 - 1. R8 counts from 7 to 0. ; Loop 8 times for 8 groups of 6-bit-to-4-bit substitutions. ; ; R7 = Index into IE as start position offset for input bits. ; Indexes from 0 to 41 step 6 ; over 8 groups of 6 input bits. ; ; R6 = Index into IE as start position offset for output bits. ; Indexes from 0 to 27 step 4 ; over 8 groups of 4 output bits. ; ; R1 = Row index into substitution table SBOX(b) (b=R8) ; Bit#5 from 6 bit subgroup of IE becomes bit#0 of R1 and ; bit#0 from 6 bit subgroup of IE becomes bit#1 of R1. The ; result is interpreted as a two bit binary number. ; ; R0 = Column index into substitution table SBOX(b) (b=R8) ; Bit#1-bit#4 of 6 bit subgroup of IE becomes bit#0-bit#3 of R0. ; The result is interpreted as a four bit binary number. ; ;INITIALIZE LOOP MOVZBL #7,R8 ;Loop control counter b CLRQ R6 ;R6 = Offset into IE for output groups of 4 ;R7 = Offset into IE for input groups of 6 ;LOOP OVER 8 GROUPS 100$: EXTZV R7,#6,(R9),R0 ;Next 6 bits from IE to R0 CLRL R1 ;Copy bit#0 of R0 to bit#0 of R1. BLBC R0,110$ ; test R0 bit#0 INCL R1 ; set R1 bit#0 110$: BBC #5,R0,120$ ;Copy bit#5 of R0 to bit#1 of R1. BISB2 #^B0010,R1 ; set R1 bit#1 120$: BICB2 #^B11100001,R0 ;Move bits#1-4 of R0 to bits#0-3 of R0. ASHL #-1,R0,R0 ;. MULL3 #<16*4>,R8,R2 ;Calculate index into S-box. R2 now points to start of SBOX(b) MULL2 #16,R1 ; (16 per row) ADDL2 R1,R2 ; R2 now points to row within SBOX(b) ADDL2 R0,R2 ; R2 now points to data element MOVZBL DES_SBOX[R2],R2 ;R2 now contains data element INSV R2,R6,#4,(R9) ;Move 4 bit data element to IE ADDL2 #6,R7 ;Advance input offset R7 to next start bit in IE ADDL2 #4,R6 ;Advance output offset R6 to next start bit in IE SOBGEQ R8,100$ ;Loop (R8=b, block number) ;STEP 5 PERMUTE in=(R9), - ;(R9)=IE (32 bits) out=R2, - ;R2 = Permuted IE (also clears R3) data=DES_PFP, - ;Permutation Function P (table 5) nbits=#32 ; ;Add permuted IE to LN XORL2 R2,12(R9) ;R2 = permuted IE, 12(R9) = LN AOBLSS #16,R11,190$ ;Test for last iteration. BRB 200$ ;Exit loop. Skip step 6 last time through. ;STEP 6 190$: MOVL 8(R9),R0 ;RN -> temp MOVL 12(R9),8(R9) ;LN -> RN MOVL R0,12(R9) ;temp -> LN BRW 10$ ;LOOP (STEP 7) ;STEP 8 ;Final output permutation 200$: PERMUTE in=8(R9), - ;8(R9)=LNRN out=@8(AP), - ;@8(AP)=OUTPUT data=DES_INVINIPRM, - ;Inverse of Initial Permutation (table 2) nbits=#64 ; RET ;------------------------------------------------------------------------------ .END