;---------------------------------------------------- ; "MKLOAD", "MKHPASM" and support, for HP-IPL/OS 0.41 ; with definitions contained in the 4/20/02 "all" file. ; This system turns a definition into HPASM source ; By Terry Newton, last modified 9/2/02(b) ; ; Usage: MKLOAD ;with HPASM list file in MS input ; MKHPASM DEFNAME ;outputs to MS output ; ; Input file consists of the existing HPASM list file ; with 16 bytes (14 data + CRLF) on each line... ; ; PWRD1 ADRES1 [CRLF] ; PWRD2 ADRES2 [CRLF] ; ..... ; * COMMENTS ; ; The 1st "*" char terminates the list. For best ; results prune the list so that it only contains ; the literal and string push, ENSEC/RTSEC, the ; actual dictionary, and anything likely to be ; referenced directly. ; ; Typical output.... ; DEC 4 ; ASC 2,ABCD ; DEF MAB4Z ; MAB4D DEF ENSEC ; DEF PLPSH * (LITERAL PUSH) ; OCT 000123 * 000123 ; DEF PWRD1 * WRD1 ; DEF PSTRP * (STRING PUSH) ; OCT 000004 * 000004 ; OCT 044105 * "HE" ; OCT 046114 * "LL" ; OCT 047440 * "O " ; OCT 000005 * 000005 ; DEF PWRD2 * WRD2 ; DEF RTSEC * END ; MAB4Z EQU * ; ; String equivalents are not that intelligent, it is ; possible for undesirable ascii characters to be ; included in the "xx" comments. Edit output as needed. ; "LOADING CONSTANTS" $PRINT CRLF ; MARKCON 777 ;the following are private definitions ; ; for readability... update if kernal changes OCTAL CONSTANT @MSINP 350 ;ZMINP, mass-storage input OCTAL CONSTANT @MSOUT 351 ;ZMOUT, mass-storage output OCTAL CONSTANT @OUT 347 ;ZOUT, regular output ; "LOADING MKFIXNAME SUBROUTINE" $PRINT CRLF OCTAL DEFINE MKFIXNAME ; string on stack, removed and replaced with adjusted string ; remove appended spaces.. DO $LEN DUP IFZ #1 ELSE DEC $GET 40 SUB IFZ $TAIL DROP #0 ELSE #1 ENDIF ENDIF UNTIL $LEN ;save true length of name "000" $CAT ; append 0's to name ;adjust header string... #0 3 +DO ;replace space with 0 INDEX $GET 40 SUB IFZ INDEX 60 $PUT ENDIF ;replace $ with S INDEX $GET 44 SUB IFZ INDEX 123 $PUT ENDIF ;replace @ with A INDEX $GET 100 SUB IFZ INDEX 101 $PUT ENDIF ;replace > with 2 INDEX $GET 76 SUB IFZ INDEX 62 $PUT ENDIF ;replace < with F INDEX $GET 74 SUB IFZ INDEX 106 $PUT ENDIF +LOOP ;if length > 3 then replace 3rd char with 4th char, ;replace 4th char with 2nd char, replace 2rd char with ;char representing length (length on stack) DUP 3 SUB IF<0 ;if length <=3 then DROP ;no action needed ELSE ;if length > 3 then 2 3 $GET $PUT ;write 4th char to 3rd char 3 1 $GET $PUT ;write 2nd char to 4th char 60 ADD ;convert len to ascii DUP 71 SWAP SUB IF<0 7 ADD ENDIF ;skip invalid chars 1 SWAP $PUT ;write to 2nd char of string ENDIF END ; VARIABLE MKEND ; private variable set by MKLOAD ; GLOBAL ; end private definitions SETCON 777 ; use above definitions ; "LOADING MKLOAD" $PRINT CRLF ; ; "MKLOAD" - this command sets MS output to memory blocks, ; loads a list file from MS input into memory. The variable ; "MKEND" will contain the location of the "*" character ; which marks the end of the cross-reference entries. ; OCTAL DEFINE MKLOAD "LOADING INPUT FILE..." $PRINT @MSOUT GET ;save MS out vector #0 OUTBLOCK ;default MS input, output to block #0 ;load list file into blocks up to and including * DO MSBIN DUP MSBOUT 52 SUB WHILE 40 MSBOUT MKEND GETOP 2 SUB PUT ;save location of the * in MKEND ;translation table now in memory, 8 words per line ;last entry begins with "* " to indicate end of table @MSOUT SWAP PUT ;restore MS out vector END ; "LOADING MKHPASM" $PRINT CRLF OCTAL DEFINE MKHPASM ; ; "MKHPASM" - creates HPASM source for the definition ; after it on the command line, for console/batch use only. ; MKLOAD must be run first to load the list file into memory ; and set the MKEND variable. Outputs to MS. ; If MSout<>console then indicates progress on console. ; Uses absolute location 175 octal for a work variable, ; doesn't have to be preserved between calls. ; mod 9/2 - location 176 literal flag - if lit.push set to 1 ; if str push set to value of next location - counts down till ; zero again - while non 0 suppress interpreting as instructions OCTAL ;make sure in octal mode TOKEN ;get next token from the command line IFNZ ;if end of the line... "USAGE: MKHPASM DEFNAME" $PRINT CRLF "RUN MKLOAD FIRST TO LOAD HPIPLOS.LST" $PRINT CRLF "OUTPUTS HPASM CODE TO MS OUTPUT" $PRINT ELSE SDIC ;search for specified definition IFZ ;if not found "NOT FOUND" $PRINT ELSE ;def's address on stack... DUP GET @ENSEC SUB ;test entry point for ENSEC IFNZ ;if not ENSEC then "CANT CONVERT" $PRINT DROP ELSE ;otherwise everything seems to be in order... @MSINP GET S>Z ;save MS input vector on Z stack @TB2 GET S>Z @TB1 GET S>Z ; save token specs @TL GET S>Z #0 INBLOCK ;direct MS input from block #0 ;write comments and stuff "*" MS$OUT 6412 MSWOUT "* " 42 $APPEND DUP HEADER$ ;push name of definition to X stack @MSOUT GET @OUT GET SUB ;compare out vectors IFNZ ;if ms out vector <> print vector "MAKING CODE FOR " $PRINT $DUP $PRINT ENDIF $TAIL DROP ;delete extra space added by HEADER$ $CPY ;copy header name to Y for later $CAT 42 $APPEND MS$OUT " - generated by MKHPASM" MS$OUT 6412 MSWOUT "*" MS$OUT 6412 MSWOUT ; output length... " OCT " MS$OUT Z>S $STR MS$OUT 6412 MSWOUT ; output name... " ASC 2," MS$OUT Z>S MSWOUT Z>S MSWOUT 6412 MSWOUT " DEF M" MS$OUT ; output start of link Y>>X MKFIXNAME ;finish link line... #0 2 +DO INDEX $GET MSBOUT +LOOP "Z" MS$OUT 6412 MSWOUT ;output entry line... "M" MS$OUT #0 3 +DO INDEX $GET MSBOUT +LOOP " DEF ENSEC" MS$OUT 6412 MSWOUT X>>Y ;save name for next time INC ; bump code pointer DUP DEC DEC GET DEC ;get link address-1 @MSOUT GET @OUT GET SUB ;compare out vectors IFNZ ;if ms out vector <> print vector ;display how many words will be generated... OVER OVER SWAP SUB INC DECIMAL "(" $PRINT PNUM "WORDS PLUS HEADER)" $PRINT CRLF OCTAL ENDIF 176 #0 PUT ;mod - clear literal counter +DO ;loop for every word that requires output INDEX GET ; get data to compile ; search the listing for an address match, if found ; output DEF label, if not found then check to see if ; it has a header.. if so make up a label name using same ; P+chars2-5 scheme used to encode entry name, if not ; then output as raw OCT code - not perfect but will do ; use HEADER$ function to comment #0 ; match flag on stack (now data,match) ; if data is >= start of blocks, then can't possibly be ; a labeled address. Only search if < start of blocks. OVER @BLK GET SUB ;data - start of blocks 176 GET IFNZ DROP #0 ENDIF ;mod - no match for literals IF<0 ;if data < start of blocks... 175 #0 PUT ;initialize list-file byte pointer ;find best place to start search... DO 175 DUP GET 1000 ADD PUT ;add 512 to pointer MKEND GET 175 GET SUB ;subtract pointer from end IF<0 ;if past load #1 ;stop ELSE 175 GET 7 ADD SETIP MS$IN ;input address DUP $TAIL DROP $VAL SUB ;subtract address from target IF<0 #1 ELSE #0 ENDIF ;stop looping if past address ENDIF UNTIL 175 DUP GET 1000 SUB PUT ;subtract 512 from pointer ;pointer set to just before potential match DO ;until I say so 175 GET SETIP MSWIN 25040 SUB ;check for "* " IFZ ;if end of records #1 ;now done ELSE OVER ;push data over match flag 175 GET 7 ADD SETIP MS$IN ;get address field $TAIL DROP ;drop the extra space for proper conversion $VAL SUB ;convert to binary and compare with data DUP ;dup for next test IF<0 ;if past address... DROP #1 ;drop dup and stop looping ELSE ;not past address yet IFZ ;if a match ;make 5 char string equal to label 175 GET SETIP "" #1 5 +DO MSBIN $APPEND +LOOP DROP #1 ; a match! #1 ;do no more ELSE #0 ;keep looping ENDIF ENDIF ENDIF 175 DUP GET 20 ADD PUT ;increment entry pointer UNTIL ;loop until non-zero stack ENDIF ;start of blocks test ; if stack <>0 then match occured, label string on stack IFNZ ;if match... " DEF " $SWAP $CAT MS$OUT " * " MS$OUT DUP @LITERAL SUB IFZ "(LITERAL PUSH)" 176 #1 PUT ;mod - set literal counter to 1 ELSE DUP @STRING SUB IFZ "(STRING PUSH)" 176 INDEX INC GET INC PUT ;mod set lit.cnt to #elements+1 ELSE DUP @RTSEC SUB IFZ "END" ELSE DUP HEADER$ ENDIF ENDIF ENDIF MS$OUT 6412 MSWOUT ;output it w/comments ELSE ;no match occured, see if can guess... DUP 100000 AND ;check if bit 15 set 176 GET IFNZ ;if doing literal data.. 176 DUP GET DEC PUT ;subtract 1 from lit.counter DROP #1 ;forced data ENDIF IFZ ;if bit 15 clear... (and not literal) DUP HEADER$ MKFIXNAME ; name and bug-proof #0 $GET 133 SUB ;compare first char w/ "[" ELSE ;if bit 15 set... (or literal) #0 ;don't fake name, process as data "" ;empty string to drop ENDIF IFNZ ;if it's a real definition name then fake name... " DEF M" MS$OUT #0 3 +DO INDEX $GET MSBOUT +LOOP " * " MS$OUT DUP HEADER$ MS$OUT " (faked)" MS$OUT 6412 MSWOUT $DROP ELSE ;must be literal data $DROP " OCT " MS$OUT DUP $STR MS$OUT " * " MS$OUT DUP 20040 SUB ;check if string data... OVER 77577 SUB IF<0 ELSE DROP -1 ENDIF 176 GET IFZ DROP -1 ENDIF ;9/2/02 IF<0 ;if it doesn't look like string data DUP $STR MS$OUT ;comment with actual number ELSE ;if looks like a string then 42 MSBOUT DUP MSWOUT 42 MSBOUT ;quote it ENDIF 6412 MSWOUT ENDIF ;fake-it test ENDIF ;listing match test DROP ;drop the data @MSOUT GET @OUT GET SUB ;compare out vectors IFNZ ;if ms out vector <> print vector "*" $PRINT ;appease the impatient user ENDIF +LOOP ;finish up... "M" MS$OUT Y>>X #0 2 +DO INDEX $GET MSBOUT +LOOP "Z EQU *" MS$OUT 6412 MSWOUT $DROP @MSINP Z>S PUT ;restore MS input vector ENDIF ;ENSEC test ENDIF ;token found test ENDIF ;initial token presence test END ; ; a little debugging utility.. MS output to console "LOADING MS>CON" $PRINT CRLF OCTAL DEFINE MS>CON @MSOUT @OUT GET PUT END ; ; a sys-gen that saves blocks too, to avoid having ; to reload the list file every time ; "LOADING MYSYS" $PRINT CRLF OCTAL DEFINE MYSYS "SAVING HIPIPLOS AND DICTIONARY..." $PRINT 2 3 ABSOUT 100 EOD ABSOUT CRLF "SAVING BLOCKS..." $PRINT @BLK GET @END GET ABSOUT CRLF "SAVING OCTAPUS..." $PRINT 70000 72777 ABSOUT PTZERO END ;-------------------------------------------------- SETCON 0 "DONE." $PRINT CONSOLE