tar listing seems to be working

This commit is contained in:
~d6 2024-09-14 01:22:04 -04:00
parent 077ee3d109
commit 4b643ea646
2 changed files with 81 additions and 16 deletions

View File

@ -61,7 +61,7 @@
( internal: store character c in the buffer and update position ) ( internal: store character c in the buffer and update position )
&save ( c^ -> ) &save ( c^ -> )
LIT2r :arg/pos LDA2kr STH2r ( c^ addr* [pos*] ) LIT2r =arg/pos LDA2kr STH2r ( c^ addr* [pos*] )
STA LDA2kr INC2r SWP2r ( [addr1* pos*] ; addr<-c ) STA LDA2kr INC2r SWP2r ( [addr1* pos*] ; addr<-c )
STA2r JMP2r ( ; pos<-addr+1 ) STA2r JMP2r ( ; pos<-addr+1 )

95
tar.tal
View File

@ -50,21 +50,21 @@
@list ( -> ) @list ( -> )
read-header ?&ok JMP2r &ok read-header ?&ok JMP2r &ok
( dump-header )
;header/filename LDA ?&non-null ;header/filename LDA ?&non-null
#800f DEO BRK #800f DEO BRK
&non-null &non-null
;header/type LDA ( type^ ) ;header/type LDA ( type^ )
DUP #00 EQU ?list-file ( ) DUP #00 EQU ?list-file-v ( )
DUP LIT "0 EQU ?list-file ( ) DUP LIT "0 EQU ?list-file-v ( )
DUP LIT "5 EQU ?list-dir ( ) DUP LIT "5 EQU ?list-dir-v ( )
!list-unsupported ( ) !list-unsupported ( )
@list-file ( 00^ -> ) @list-file ( 00^ -> )
POP POP
LIT "f #18 DEO #2018 DEO LIT "f #18 DEO #2018 DEO
;header/filename print #0a18 DEO ;header/filename print #0a18 DEO
;header/size load-octal11 ;header/size load-octal11 round-up-to-512 skip !list
round-up-to-512 skip !list
@list-dir ( 00^ -> ) @list-dir ( 00^ -> )
POP POP
@ -72,6 +72,30 @@
;header/filename print #0a18 DEO ;header/filename print #0a18 DEO
!list !list
@list-file-v ( 00^ -> )
POP
LIT "f #18 DEO #2018 DEO
( ;header/mode #0008 dump-mem0 )
( ;header/owner #0008 dump-mem0 )
( ;header/group #0008 dump-mem0 )
( ;header/size #000b dump-mem0 )
( ;header/mtime #000b dump-mem0 )
;header/size load-octal11 dump-longer #2018 DEO
;header/filename print #0a18 DEO
;header/size load-octal11 round-up-to-512 skip !list
@list-dir-v ( 00^ -> )
POP
LIT "d #18 DEO #2018 DEO
( ;header/mode #0008 dump-mem0 )
( ;header/owner #0008 dump-mem0 )
( ;header/group #0008 dump-mem0 )
( ;header/size #000b dump-mem0 )
( ;header/mtime #000b dump-mem0 )
;header/size load-octal11 dump-longer #2018 DEO
;header/filename print #0a18 DEO
!list
@list-unsupported ( type^ -> ) @list-unsupported ( type^ -> )
;unsupported print emit/byte #0a18 DEO !panic ;unsupported print emit/byte #0a18 DEO !panic
!list !list
@ -150,11 +174,11 @@
&ok JMP2r &ok JMP2r
@octal-digit ( char^ -> oct^ ) @octal-digit ( char^ -> oct^ )
LIT "0 DUP2 LTH ?&zero SUB JMP2r &zero POP2 #00 JMP2r LIT "0 LTHk ?&zero SUB JMP2r &zero POP2 #00 JMP2r
( returns values between #00:0000:0000 and #01:ffff:ffff ) ( returns values between #00:0000:0000 and #01:ffff:ffff )
@load-octal11 ( addr* -> carry^ hi* lo* ) @load-octal11 ( addr* -> carry^ hi* lo* )
INC2k load-octal10 ( addr* hi* lo* ) INC2k load-octal10 ( addr* hi* lo* ; load addr+1 )
STH2 STH2 ( addr* [lo* hi*] ) STH2 STH2 ( addr* [lo* hi*] )
LDA ( LIT "0 SUB ) octal-digit STH2r STH ( octal^ a^ [lo* b^] ) LDA ( LIT "0 SUB ) octal-digit STH2r STH ( octal^ a^ [lo* b^] )
#20 SFT #02 SFT2 STHr STH2r ( carry^ hi* lo* ) #20 SFT #02 SFT2 STHr STH2r ( carry^ hi* lo* )
@ -190,14 +214,55 @@
JMP2r JMP2r
( round a given 5-byte size up to multiples of 512 ) ( round a given 5-byte size up to multiples of 512 )
@round-up-to-512 ( carry^ hi* lo* -> ) @round-up-to-512 ( carry^ hi* lo* -> chl^** )
DUP2 #fe00 GTH2 ?&round-hi DUP2 #01ff AND2 ORA ?{ JMP2r }
#0200 OVR2 #01ff AND2 SUB2 ADD2 JMP2r DUP2 #fe00 GTH2 ?{ #0200 OVR2 #01ff AND2 SUB2 ADD2 JMP2r }
&round-hi POP2 DUP2 #ffff EQU2 ?{ INC2 #0000 JMP2r }
POP2 DUP2 #ffff EQU2 ?&round-carry INC2 #0000 JMP2r POP2 INC #0000 #0000 JMP2r
&round-carry
POP2 DUP #ff EQU ?&overflow INC #0000 #0000 JMP2r @dump-longer ( carry^ long** -- )
&overflow #0000 DIV STH2 STH2 dump-byte STH2r STH2r ( >> )
@dump-long ( long** -- )
SWP2 dump-short ( >> )
@dump-short ( short* -- )
SWP dump-byte ( >> )
@dump-byte ( byte^ -- )
DUP #04 SFT /hex #0f AND ( >> )
&hex #30 ADD DUP #39 GTH #27 MUL ADD #18 DEO
JMP2r
@dump-mem ( start* size* -> )
OVR2 ADD2 SWP2 ( lim* start* )
LDAk dump-byte INC2 ( lim* start+1* )
&loop GTH2k ?&ok POP2 POP2 #0a18 DEO JMP2r ( lim^ pos^ )
&ok #2018 DEO LDAk dump-byte INC2 !&loop ( lim^ pos+1^ )
@dump-mem0 ( start* size* -> )
#0001 SUB2 OVR2 ADD2 SWP2
&loop GTH2k ?{ NIP2 LDA #18 DEO #2018 DEO JMP2r }
LDAk #30 GTH ?{ #2018 DEO INC2 !&loop }
LDAk #18 DEO INC2 ( >> )
&loop2 GTH2k ?{ NIP2 LDA #18 DEO #2018 DEO JMP2r }
LDAk #18 DEO INC2 !&loop2
@dump-header ( -> )
LIT2 "- 18 DEOk DEOk DEOk DEOk DEO #0a18 DEO
;header/filename #0064 dump-mem
;header/mode #0008 dump-mem
;header/owner #0008 dump-mem
;header/group #0008 dump-mem
;header/size #000c dump-mem
;header/mtime #000c dump-mem
;header/checksum #0008 dump-mem
;header/type #0001 dump-mem
;header/linkname #0064 dump-mem
LIT2 "- 18 DEOk DEOk DEOk DEOk DEO #0a18 DEO
LIT2 "s 18 DEO #2018 DEO
;header/size load-octal11 dump-longer #0a18 DEO
LIT2 "t 18 DEO #2018 DEO
;header/size load-octal11 round-up-to-512 dump-longer #0a18 DEO
LIT2 "- 18 DEOk DEOk DEOk DEOk DEO #0a18 DEO
JMP2r
( header/size is 11 octal digits; 12th digit is NUL ) ( header/size is 11 octal digits; 12th digit is NUL )
( octal 77777777777 = #01 #ffff #ffff ) ( octal 77777777777 = #01 #ffff #ffff )